
//////////////////////////////////////////////////
//  DB Access Components
//  Copyright © 1998-2007 Core Lab. All right reserved.
//  CRXml
//////////////////////////////////////////////////

unit CRXml;

interface

{$I Dac.inc}
uses
  Classes, SysUtils, Contnrs, CLRClasses;

type

  TChars = array of char;

  TextReader = class
  end;

  StreamReader = class(TextReader)
  private
    FReader: TStream;
    FCapacity: Integer;
    FReleaseReader: Boolean;
    function Eof: Boolean;
  public
    constructor Create(const path: string; detectEncodingFromByteOrderMarks: Boolean); overload;
    constructor Create(input: TStream); overload;
    destructor Destroy; override;
    procedure Close;
    function Read(buffer: TChars; Index, Count: Integer):Integer;
    function ReadLine:string;
    function ReadToEnd:string;
    
    property BaseStream: TStream read FReader;
  end;

  StringReader = class(TextReader)
  private
    FText: string;
  public
    constructor Create(Text: string);
  end;

  StreamWriter = class
  private
    FWriter: TStream;
    FReleaseWriter: Boolean;
    FEncodingClass: EncodingClass;
  public
    constructor Create(const path: string; Append: Boolean); overload;
    constructor Create(output: TStream; Encoding: EncodingClass); overload;
    destructor Destroy; override;

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

  XmlException = class(Exception);

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

  XmlTextReader = class
  private
    FText: string;
    FTextlc: string;
    FPrefix: string;
    FValue: string;
    FName: string;
    FNodeType: XmlNodeType;
    FAttrNames: TStringList;
    FAttrPrefix: TStringList;
    FAttrValues: TStringList;
    FOffset: Integer;
    FTextLen: Integer;
    FState: XmlReadState;
    FCurrElementName: string;
    FReader: StreamReader;
    FEof: Boolean;
    function GetHasAttributes: Boolean;
    function GetDepth: integer;
    function GetAttributeCount: integer;
    procedure GetXMLNodeAttributes(const Node: string; AttrNames: TStrings;
       AttrValues: TStrings);
    procedure ReadFromStream;
    procedure InitInstance;
    function GetEof:Boolean;
  protected
    function ScanLine(Lexem: array of string; Offset: Integer = -1):Boolean;
  public
    constructor Create(Reader: TextReader);
    destructor Destroy; override;

    procedure MoveToAttribute(i: integer); overload;
    function MoveToAttribute(name: string):Boolean; overload;
    function Read: boolean;
    function MoveToElement: boolean;
    function Items(const Index: Integer): string; overload;
    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 FEof;
    property HasAttributes: Boolean read GetHasAttributes;
  end;

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

  XmlTextWriter = class
  private
    FText: string;
    FFormatting: XmlFormatting;
    FIndentation: Integer;
    FIndentChar: Char;
    FQuoteChar: Char;
    FWriteState: XmlWriteState;
    FDepth: Integer;
    FPrefix: TStringList;
    FPosStack: TStack;
    FTagStack: TStringList;
    FWriter: StreamWriter;
    function IndentStr: string;
    function PopTagName: string;
    procedure PushTagName(const TagName: string);
    procedure InternalCloseStartTag;
  protected
    procedure InternalWriteStartElement(const Prefix, LocalName, ns: string);
    procedure InternalWriteElementString(const LocalName, ns, Value: string);
    procedure InternalWriteAttributeString(const Prefix, LocalName, ns, Value: string);
    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: string);
    procedure WriteElementString(const LocalName, ns, value: string); overload;
    procedure WriteElementString(const LocalName, Value: string); overload;

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

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

implementation
uses
{$IFDEF VER7P}
  StrUtils,
{$ENDIF}
  MemUtils, CRParser;

const
  LineSeparator = #13#10;
  SInvalidXML = 'Invalid XML';
  SClassNotSupported = 'Class %s is not supported';

  procedure DeleteInvisibleSymbol(var s: string); forward;
  function XMLDecode(const AStr: String): String; forward;
  function CompareLexem(const s, Substr: string; Index: Integer):Boolean; forward;

type
  TXmlParser = class(TParser)
  public
    constructor Create(const Text: string); override;
  end;

var
  XmlSymbolLexems, XmlKeywordLexems: TStringList;

 { XmlTextReader }

constructor XmlTextReader.Create(Reader: TextReader);
begin
  inherited Create;


  if Reader.InheritsFrom(StreamReader) then begin
    FTextLen := -1;
    FReader := StreamReader(Reader);
    ReadFromStream;
  end
  else
    if Reader.InheritsFrom(StringReader) then begin
      FReader := nil;
      FText := StringReader(Reader).FText;
      FTextLen := Length(FText);
      FTextlc := LowerCase(FText);
    end
    else
      raise Exception.CreateFmt(SClassNotSupported, [Reader.ClassName]);
  InitInstance;
end;

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

  inherited;
end;

procedure XmlTextReader.ReadFromStream;
begin
  if Assigned(FReader) then begin
    if (FOffset  >= FTextLen) then begin
      if not FReader.Eof then begin
        FText := '';
        repeat
          FText := FText + ' ' + TrimRight(FReader.ReadLine);
        until (Pos('>', FText) <> 0) or FReader.Eof;
        FTextlc := LowerCase(FText);
        FTextLen := Length(FText);
        FOffset := 1;
      end
      else
        FEof := True;
    end;
  end;
end;

function XmlTextReader.MoveToElement: boolean;
begin
  Result := False;
end;

function XmlTextReader.ScanLine(Lexem: array of string; Offset: Integer = -1):Boolean;
var
  i: Integer;
  Str: string;
begin
  ReadFromStream;
  Result := False; // Make compiler happy;
  if Offset <> -1 then
    FOffset := Offset;
  while (FOffset <= FTextLen) do begin
    Result := False;
    for i := Low(Lexem) to High(Lexem) do begin
      Str := Copy(FTextlc, FOffset, Length(Lexem[i]));
      if Str = Lexem[i] then begin
        Result := True;
        inc(FOffset, Length(Lexem[i]));
        break;
      end;
    end;
    if Result then
      break;
    inc(FOffset);
  end;

  if (not Result) and (not GetEof) then
    Result := ScanLine(Lexem);
end;

function XmlTextReader.Read: boolean;
var
  Node: string;
  NextLexem: Integer;
  OldOffset: Integer;
  EndTagName: string;
  ChildTag: Integer;
  k: Integer;
  IsTextFound: Boolean;
begin
   Result := False;
   ReadFromStream;
   
   if (FState in [Initial, Interactive]) then begin
       IsTextFound := False;
       if NodeType = ntElement then begin
         k := FOffset;
         while (FTextlc[k] <> '<') and (k <= Length(FTextlc)) do begin
           if FTextlc[k] in ['a'..'z', '0'..'9', '.', ':'] then begin
             IsTextFound := True;
             break;
           end;
           inc(k);
         end;
         if IsTextFound then begin
           FNodeType := ntText;
           inc(FOffset);
         end;
       end;

     if not IsTextFound then begin
       if not ScanLine(['<']) then begin
         if Eof then
           exit;
         FState := Error;
         XmlException.Create('Root element missing');
       end;
       if FTextlc[FOffset] = '?' then
         FNodeType := ntDeclaration
       else if CompareLexem(FTextlc, '!--', FOffset) then
         FNodeType := ntComment
       else if CompareLexem(FTextlc, '!DOCTYPE', FOffset) then
         FNodeType := ntDocumentType
       else if FTextlc[FOffset] = '/' then begin
         FNodeType := ntEndElement;
       end
       else if (FTextlc[FOffset-1] = '<') then
         FNodeType := ntElement
       else
         Assert(False);
     end;
     FState := Interactive;
   end;

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

   case FNodeType of
     ntDeclaration: begin
       inc(FOffset);
       NextLexem := PosEx(' ', FTextlc, FOffset);
       if NextLexem <> -1 then begin
         FName := Trim(Copy(FText, FOffset, NextLexem-FOffset));
         inc(FOffset, NextLexem-FOffset);
       end;
       if ScanLine(['?>']) then
         FValue := Trim(Copy(FText, NextLexem, FOffset-NextLexem-2))
       else begin
         FState := Error;
         raise XmlException.Create('Invalid declaration tag');
       end;
       Result := True;
     end;

     ntComment: begin
       inc(FOffset, 3);
       NextLexem := FOffset;
       if ScanLine(['-->']) then
         FValue := Trim(Copy(FText, NextLexem, FOffset - NextLexem - 3))
       else begin
         FState := Error;
         raise XmlException.Create('Invalid comment tag');
       end;
       Result := True;
     end;

     ntDocumentType: begin
       inc(FOffset, 8);
       NextLexem := FOffset;
       if ScanLine(['[<']) then begin
         FName := Trim(Copy(FText, NextLexem, FOffset - NextLexem - 2));
         NextLexem := PosEx('>]', FTextlc, FOffset);
         FValue := Trim(Copy(FText, FOffset, NextLexem - FOffset));
         inc(FOffset, NextLexem - FOffset)
       end
       else begin
         FState := Error;
         raise XmlException.Create('Invalid Document type tag');
       end;

       Result := True;
     end;

     ntEndElement: begin
       inc(FOffset);
       NextLexem := PosEx('>', FTextlc, FOffset);
       FName := Trim(Copy(FText, FOffset, NextLexem - FOffset));
       FOffset := NextLexem;
       Result := True;
     end;

     ntElement: begin
       if FTextlc[FOffset-1] = '<' then begin
         NextLexem := PosEx('>', FTextlc, FOffset);
         Node := Copy(FText, FOffset, NextLexem - FOffset+1);

         OldOffset := FOffset;
         ScanLine([' ','>']);
         FName := Trim(Copy(FText, OldOffset, FOffset - OldOffset - 1));
         Delete(Node, 1, Length(FName));
         GetXMLNodeAttributes(Node, FAttrNames, FAttrValues);

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

         FOffset := NextLexem;
         Result := True;
       end;
     end;

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

       if FCurrElementName[Length(FCurrElementName)] = '/' then
         NextLexem := FOffset + Length(FCurrElementName)
       else
         NextLexem := PosEx(EndTagName, FTextlc, FOffset);
       FValue := Trim(Copy(FText,FOffset, NextLexem - FOffset));
       ChildTag := PosEx('<', FValue);
       if (ChildTag <> 0) and (not CompareLexem(FValue, '<!', ChildTag)) then begin // omit <![CDATA
         FValue := Trim(Copy(FValue, 1, ChildTag-1));
         if ChildTag = 1 then
           FOffset := FOffset + ChildTag
         else
           FOffset := FOffset + ChildTag-1;

       end
       else
         FOffset := NextLexem;
       Result := True;
     end;
   else
     begin
      FState := Error;
      Assert(False);
     end;
   end;
end;

procedure XmlTextReader.GetXMLNodeAttributes(const Node: string; AttrNames: TStrings; AttrValues: TStrings);
var
  Parser: TXmlParser;
  Code: integer;
  Lexem: string;
  AttrName: string;
  AttrValue: string;
  AttrPrefix: string;
  WithColon: boolean;
begin
  FAttrNames.Clear;
  FAttrValues.Clear;
  FAttrPrefix.Clear;
  Parser := TXmlParser.Create(Node);
  try
    while True do begin
      Code := Parser.GetNext(Lexem);
      case Code of
        lcEnd, 18, 20: // '<', '>'
          break;
        lcIdent: begin
          WithColon := False;
          AttrName := Lexem;
          AttrPrefix := '';
          Code := Parser.GetNext(Lexem);
          if Code = lcIdent then begin
            AttrName := Lexem;
            Code := Parser.GetNext(Lexem);
          end;
          if Code in [16, 19] then begin
            if Code = 16 then begin // ':'
              Code := Parser.GetNext(Lexem);
              if Code <> lcIdent then
                raise XmlException.Create(SInvalidXML);
              AttrPrefix := AttrName;
              AttrName := AttrPrefix + ':' + Lexem;
              Code := Parser.GetNext(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({UTF8Decode}(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 XMLDecode(const AStr: String): String;
var
  sb: StringBuilder;
begin
  sb := StringBuilder.Create(AStr, Length(AStr));
  try
    sb.Replace('&#x27;', '''');
    sb.Replace('&#x22;', '"');
    sb.Replace('&#x3c;', '<');
    sb.Replace('&#x3e;', '>');
    sb.Replace('&#x26;', '&');
    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;

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

function CompareLexem(const s, Substr: string; Index: Integer):Boolean;
var
  tmp: string;
  Len: Integer;
begin
  Len := Length(Substr);
  tmp := Copy(s, Index, Len);
  Result := CompareText(tmp, Substr) = 0;
end;

procedure XmlTextReader.InitInstance;
begin
  if FTextLen > 0 then
    FEof := False
  else
    FEof := True;
  FState := Initial;
  FNodeType := ntNone;
  FOffset := 1;
  FAttrNames := TStringList.Create;
  FAttrPrefix := TStringList.Create;
  FAttrValues := TStringList.Create;
  FCurrElementName := '';
end;

function XmlTextReader.GetEof: Boolean;
begin
  if Assigned(FReader) then
    Result := FReader.Eof
  else begin
    Result := FOffset >= FTextLen;
    FEof := Result;
  end;
end;

{ XmlTextWriter }

constructor XmlTextWriter.Create(w: StreamWriter);
begin
  FFormatting := fmtNone;
  FIndentation := 2;
  FIndentChar := ' ';
  FQuoteChar := '"';
  FWriteState := wsStart;
  FDepth := 0;
  FPrefix := TStringList.Create;
  FPosStack := TStack.Create;
  FTagStack := TStringList.Create;
  FWriter := w;
end;

destructor XmlTextWriter.Destroy;
begin
  FPrefix.Free;
  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 + LineSeparator;

  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(Pointer(EndTagPos));
  if Prefix <> '' then
    PushTagName(Prefix + ':' + LocalName)
  else
    PushTagName(LocalName);

  FWriteState := wsElement;
end;

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

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

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

procedure XmlTextWriter.InternalWriteAttributeString(const Prefix, LocalName, ns, Value: string);
var
  AttrPos: Integer;
  AttrStr: string;
begin
  if FWriteState in [wsElement, wsAttribute] then
    AttrPos := Integer(FPosStack.Pop) + 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 +  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(Pointer(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 + LineSeparator + IndentStr + '</' + PopTagName + '>'
  else
    FText := FText + '</' + PopTagName + '>';
  FWriteState := wsContent;
end;

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

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

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

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

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

procedure XmlTextWriter.WriteAttributeString(const Prefix, LocalName, ns, Value: string);
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: string;
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
    FWriter := TFileStream.Create(path, fmOpenReadWrite);
    FWriter.Seek(0, soFromEnd);
  end
  else
    FWriter := TFileStream.Create(path, fmCreate);
  FReleaseWriter := True;
end;

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

  FWriter := output;
  FReleaseWriter := False;
  FEncodingClass := Encoding;
end;

destructor StreamWriter.Destroy;
begin
  if FReleaseWriter then
    FWriter.Free;

  inherited;
end;

procedure StreamWriter.Close;
begin
end;

procedure StreamWriter.Flush;
begin
end;

procedure StreamWriter.Write(value: string);
var
  Str: string;
begin
  if FEncodingClass <> nil then begin
    Str := FEncodingClass.GetString(TBytes(value));
    FWriter.Write(PChar(Str)^, Length(Str));
  end
  else
    FWriter.Write(PChar(value)^, Length(value));
end;

procedure StreamWriter.WriteLine(const value: string);
begin
  Write(value + LineSeparator);
end;

  { StreamReader }

constructor StreamReader.Create(const path: string; detectEncodingFromByteOrderMarks: Boolean);
begin
  FCapacity := 512;
  FReader := TFileStream.Create(path, fmOpenRead);
  FReleaseReader := True;
end;

constructor StreamReader.Create(input: TStream);
begin
  FCapacity := 512;
  FReader := input;
  FReleaseReader := False;
end;

destructor StreamReader.Destroy;
begin
  if FReleaseReader then
    FReader.Free;
end;

function StreamReader.Eof: Boolean;
begin
  Result := FReader.Position = FReader.Size;
end;

procedure StreamReader.Close;
begin

end;

function StreamReader.ReadToEnd:string;
var
  Len: Int64;
begin
  Len := FReader.Size - FReader.Position;
  SetLength(Result, Len);
  Read(TChars(Result), 0, Len);
end;

function StreamReader.Read(buffer: TChars; Index, Count: Integer):Integer;
begin
  Result := FReader.Read((PChar(buffer) + Index)^, Count);
end;

function StreamReader.ReadLine:string;
var
  SeparatorPos: Integer;
  Count, BeginPos: Integer;
  Position, NextPosition: Int64;
begin
  if Eof then begin
    Result := '';
    exit;
  end;

  SetLength(Result, FCapacity);
  System.FillChar(Result[1], Length(Result), ' ');
  Position := FReader.Position;

  Count := 1;
  SeparatorPos := -1;
  BeginPos := 1;
  while True do begin
    Count := FReader.Read(Result[BeginPos], Length(Result) - BeginPos + 1);
    SeparatorPos := PosEx(LineSeparator, Result, BeginPos-1);

    if Eof or (SeparatorPos <> 0) then
      break;
    BeginPos := Length(Result)+1;
    SetLength(Result, BeginPos + Round(BeginPos * 0.3));
    System.FillChar(Result[BeginPos], Length(Result) - BeginPos + 1, ' ');
  end;

  if SeparatorPos <> 0 then
    SetLength(Result, SeparatorPos + 1)
  else
    SetLength(Result, Count);

  FCapacity := Length(Result);
  NextPosition := Position + FCapacity;
  if (Count <> 0) and (NextPosition + 1 <> FReader.Size) then
    FReader.Seek(Position - FReader.Position + FCapacity, soFromCurrent);
end;

{ TXmlParser }

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

  FSymbolLexems := XmlSymbolLexems;
  FKeywordLexems := XmlKeywordLexems;
end;

{ StringReader }

constructor StringReader.Create(Text: string);
begin
  FText := Text;
end;

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

  XmlSymbolLexems.AddObject(':', TObject(integer(16)));
  XmlSymbolLexems.AddObject('=', TObject(integer(19)));
  XmlSymbolLexems.CustomSort(CRCmpStrings);

finalization
  XmlSymbolLexems.Free;
  XmlKeywordLexems.Free;

end.
