{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   GM-Software                                               | }
{ |   ===========                                               | }
{ |                                                             | }
{ |   Project: All Projects                                     | }
{ |                                                             | }
{ |   Description: Xml implementations.                         | }
{ |                                                             | }
{ |                                                             | }
{ |   Copyright (C) - 2004 - Gerrit Moeller.                    | }
{ |                                                             | }
{ |   Source code dstributed under MIT license.                 | }
{ |                                                             | }
{ |   See: https://www.gm-software.de                           | }
{ |                                                             | }
{ +-------------------------------------------------------------+ }

{$INCLUDE GMCompilerSettings.inc}

unit GMXml;

interface

uses GMStrDef, GMCollections, GMCommon, GMIntf, GMActiveX, GMUnionValue;


type

  TGMXmlParseAttribute = (paCheckHasXmlToken, paCheckCloseMatch, paCheckAllClosed, paIgnoreComments);
  TGMXmlParseAttributes = set of TGMXmlParseAttribute;

  TXmlTokenKind = (tkUnknown, tkStart, tkEnd, tkSingle);

  TXmlSearchFlag  = (sfIgnoreCase, sfNoSelf);
  TXmlSearchFlags = set of TXmlSearchFlag;

const

  cInfiniteSearchDepth = -1;

  cDfltXmlParseAttributes = [Low(TGMXmlParseAttribute) .. High(TGMXmlParseAttribute)];

  cStrictHtmlParseAttributes = [paCheckCloseMatch .. High(TGMXmlParseAttribute)];
  cRelaxedHtmlParseAttributes = [paIgnoreComments];

  cDfltXmlSearchFlags = [Low(TXmlSearchFlag) .. High(TXmlSearchFlag)];
  cStrDfltXmlIndent = '  ';


type

  EGMXmlException = class(EGMException);

  TXmlCharCoding = (ccUnknown, ccUtf8, ccWin1252, ccISO_8859_1);
  TXmlNodeInsertPos = (ipBegin, ipEnd);
  TJunctionOperator = (joAnd, joOr);

  TGMXmlNode = class;
  TGMXmlAttribute = class;
  TGMXmlTree = class;


  TGMXmlNamedValueData = record
    Name: TGMstring;
    Value: TGMString;
  end;

  TGMNamedStrValueDataArray = array of TGMXmlNamedValueData;


  TGMAttributeSearchData = class;

  IGMAttributeSearchData = interface
    function Obj: TGMAttributeSearchData;
  end;

  TGMAttributeSearchData = class(TGMRefCountedObj, IGMAttributeSearchData)
   public
    AttributeValues: array of TGMXmlNamedValueData;
    JunctionOperator: TJunctionOperator;
    constructor Create(const AAttributeValues: array of TGMXmlNamedValueData; const AJunctionOperator: TJunctionOperator = joAnd; const ARefLifeTime: Boolean = True); reintroduce;
    function Obj: TGMAttributeSearchData;
  end;



  TDumpLineProc = procedure (const AXmlLine: TGMString; const AAppData: Pointer) of object;

  IGMXmlNode = interface(IUnknown)
    ['{242E3002-D014-4380-A7F3-A489CFBE985A}']
    function Obj: TGMXmlNode;
  end;


  TGMXmlNodeVisitFunc = function (const ANode: IGMXmlNode; const AFlags: TXmlSearchFlags = cDfltXmlSearchFlags; const AParameter: IUnknown = nil): Boolean of object;


  TGMXmlAttribute = class(TGMNameAndStrValueObj);


  TGMXmlAttributeClass = class of TGMXmlAttribute;


  TGMXmlNode = class(TGMNameAndStrValueObj, IGMXmlNode)
   protected
    FOwner: TGMXmlTree; // <- would build circualr reference when interface
    FNameSpace: TGMString;
    FParent: TGMXmlNode; // <- Dont hold a interface reference -> circular refcount problem!
    FSubNodes: IGMIntfArrayCollection;
    FAttributes: IGMIntfArrayCollection;
    FSpecialNodeCh: AnsiChar;
    FParentValueChPos: LongInt;

    procedure ParseAttributes(const Content: AnsiString); virtual;
    procedure ParseXmlToken(const AToken: AnsiString); virtual;

    constructor Create(const AOwner: TGMXmlTree; const AParent: IGMXmlNode; const AToken: AnsiString; const ANodeInsertPos: TXmlNodeInsertPos = ipEnd; const AParentValueChPos: LongInt = 0); overload; virtual;
    constructor CreateNew(const AOwner: TGMXmlTree; const AParent: IGMXmlNode; const AName, AValue: TGMString; const ANameSpace: TGMString = ''; const ANodeInsertPos: TXmlNodeInsertPos = ipEnd); overload; virtual;

    function BuildSingleNodeOutputStr(const ANSName, ANSNameWithAttr, AValStr: TGMString): TGMString; virtual;

   public
    constructor Create(const ARefLifeTime: Boolean = True); overload; override;
//  destructor Destroy; override;
    function Obj: TGMXmlNode;
//  procedure Remove;

    function AttributeCreateClass: TGmXmlAttributeClass; virtual;

    function GetPlainValue: TGMString; virtual;
    procedure SetPlainValue(const APlainValue: TGMString); virtual;

    function GetParent: IGMXmlNode;
//  function ChildNodeByIdx(const AIndex: LongInt): IGMXmlNode;

    function GetStringValue: TGMString; override;
    procedure SetStringValue(const AStrValue: TGMString); override;

    function GetUnionValue: RGMUnionValue; override;
    procedure SetUnionValue(const AValue: RGMUnionValue); override;

    procedure CopyNodeTo(const ADestRoot: IGMXmlNode; const ANodeInsertPos: TXmlNodeInsertPos = ipEnd; const ARecurse: Boolean = True);
    procedure CopySubNodesTo(const ADestRoot: IGMXmlNode; const ANodeInsertPos: TXmlNodeInsertPos = ipEnd; const ARecurse: Boolean = True);

    function DecideFindNode(const ANode: IGMXmlNode; const AFlags: TXmlSearchFlags = cDfltXmlSearchFlags; const AParameter: IUnknown = nil): Boolean; virtual;
    function IterateSubNodes(const VisitNodeFunc: TGMXmlNodeVisitFunc; const Parameter: IUnknown = nil; const Depth: Integer = cInfiniteSearchDepth; const Flags: TXmlSearchFlags = cDfltXmlSearchFlags): IGMXmlNode; virtual;
    procedure DumpContent(const AIndent, AIndentAppend: TGMString; const ADumpLineProc: TDumpLineProc; const AAppData: Pointer = nil; const ARecurse: Boolean = True);
    function FindSubNode(const AName: TGMString; const AAttributes: IGMAttributeSearchData = nil; const ADepth: Integer = cInfiniteSearchDepth; const AFlags: TXmlSearchFlags = cDfltXmlSearchFlags): IGMXmlNode; 
    function FindSubNodeIntoVar(const AName: TGMString; const AAttributes: IGMAttributeSearchData; var AFoundNode: IGMXmlNode; const ADepth: Integer = cInfiniteSearchDepth; const AFlags: TXmlSearchFlags = cDfltXmlSearchFlags): Boolean;
    function CheckFindSubNode(const AName: TGMString; const AAttributes: IGMAttributeSearchData = nil; const ADepth: Integer = cInfiniteSearchDepth; const AFlags: TXmlSearchFlags = cDfltXmlSearchFlags): IGMXmlNode;

    procedure SaveToStream(const AIndent, AIndentAppend: AnsiString; const ADest: ISequentialStream; const ARecurse: Boolean = True); 

    property Owner: TGMXmlTree read FOwner;
    property Parent: IGMXmlNode read GetParent;
    property NameSpace: TGMString read FNameSpace;
    property SubNodes: IGMIntfArrayCollection read FSubNodes;
    property Attributes: IGMIntfArrayCollection read FAttributes;
    property ParentValueChPos: LongInt read FParentValueChPos;
    property PlainValue: TGMString read GetPlainValue write SetPlainValue;
    //property ParentValueInsertChPos: LongInt read FParentValueInsertChPos write FParentValueInsertChPos;
  end;

  TGMXmlNodeClass = class of TGMXmlNode;


  IGMXmlTree = interface(IUnknown)
    ['{418F92EB-7686-43fb-8539-51B4E8DE984B}']
    function Obj: TGMXmlTree;
  end;


  TGMXmlTree = class(TGMRefCountedObj, IGMXmlTree)
   protected
    FRootNode: IGMXmlNode;
    FCharCoding: TXmlCharCoding;

    function TokenKind(const AToken: TGMString): TXmlTokenKind; virtual;
    procedure SetCharCodingAttrOfXmlNode(const ACharCoding: TXmlCharCoding);
    function CharCodingOfNode(const ANode: IGMXmlNode): TXmlCharCoding;

   public
    constructor Create(const ARefLifeTime: Boolean = True); override;

    constructor CreateRead(const ASource: ISequentialStream = nil;
                           const AParseAttributes: TGMXmlParseAttributes = cDfltXmlParseAttributes;
                           const AStopAtNode: TGMString = '';
                           const ARefLifeTime: Boolean = True); virtual;

    constructor CreateWrite(const ACharCoding: TXmlCharCoding = ccUtf8; const ARefLifeTime: Boolean = True); virtual;

    function Obj: TGMXmlTree;

    function EncodeNodeValue(const AValue: TGMString): AnsiString;
    function DecodeNodeValue(const AValue: AnsiString): TGMString;

    function NodeCreateClass: TGMXmlNodeClass; virtual;
    function CharCodingInfo: TXmlCharCoding;
    function CreateNewNode(const AParent: IGMXmlNode; const AName: TGMString; const AValue: TGMString = ''; const ANameSpace: TGMString = ''; const ANodeInsertPos: TXmlNodeInsertPos = ipEnd): IGMXmlNode;
    function CreateNodeFromToken(const AParent: IGMXmlNode; const AToken: AnsiString; const ANodeInsertPos: TXmlNodeInsertPos = ipEnd; const AParentValueChPos: LongInt = 0): IGMXmlNode;
    procedure ParseIStream(const AStream: ISequentialStream; const AParseAttributes: TGMXmlParseAttributes = cDfltXmlParseAttributes; const AStopAtNode: TGMString = ''; const Append: Boolean = False);
    procedure DumpNodes(const ADumpLineProc: TDumpLineProc; const AAppData: Pointer = nil; const AIndent: TGMString = cStrDfltXmlIndent);
    procedure SaveToStream(const ADest: ISequentialStream; const AIndent: TGMString = cStrDfltXmlIndent);
    property RootNode: IGMXmlNode read FRootNode;
    property CharCoding: TXmlCharCoding read FCharCoding write FCharCoding;
  end;

  TGMXmlTreeClass = class of TGMXmlTree;


  TGMHtmlNode = class(TGMXmlNode)
   public
    function BuildSingleNodeOutputStr(const ANSName, ANSNameWithAttr, AValStr: TGMString): TGMString; override;
  end;


  TGMHtmlTree = class(TGMXmlTree)
   protected
    function TokenKind(const AToken: TGMString): TXmlTokenKind; override;
   public 
    function NodeCreateClass: TGMXmlNodeClass; override;
  end;



function GMXmlNamedValueData(const AName, AValue: TGMString): TGMXmlNamedValueData;

function GMFindXmlSubValue(AStartNode: IGMXmlNode; const AName: TGMString; const AAttributes: IGMAttributeSearchData = nil; const ADefaultValue: TGMString = ''; const ADepth: Integer = 1): TGMString;
function GMCheckFindXmlSubValue(const AStartNode: IGMXmlNode; const AName: TGMString; const AAttributes: IGMAttributeSearchData = nil; const ADepth: Integer = 1): TGMString;
//function GMGetSubNodeValue(const ANode: IGMXmlNode; const ASubNodeName: TGMString; const AMustExist: Boolean; const ADepth: LongInt = cInfiniteSearchDepth; const ADefaultValue: TGMString = ''): TGMString;

function GMGetXmlNodeByPath(const ASartNode: IGMXmlNode; const APath: array of TGMString; var AFoundNode: IGMXmlNode): Boolean;
function GMCheckGetXmlNodeByPath(const AStartNode: IGMXmlNode; const APath: array of TGMString): IGMXmlNode;
function GMBuildXmlNodePath(AXmlNode: IGMXmlNode): TGMString;

function GMCreateXmlNode(const AParentNode: IGMXmlNode; const AName: TGMString; const AValue: TGMString = ''; const ANameSpace: TGMString = ''; const ANodeInsertPos: TXmlNodeInsertPos = ipEnd): IGMXmlNode;

function GMXmlNamedCharReplacements: IGMIntfCollection;
function GMFindXmlNamedCharReplacement(const AUmlStr: TGMString; var AReplacement: TGMString): Boolean;

function GMTextToXml(const AValue: AnsiString): AnsiString;
function GMXmlToText(const AValue: AnsiString): AnsiString;

procedure GMTraceXml(const AXml: IGMXmlTree; const AIndent: TGMString = cStrDfltXmlIndent);

function GMExtractHtmlText(const AHtmlTree: IGMXmlTree): TGMString;
function GMExtractAnyTextResponse(const AResponseContent: ISequentialStream; const AContentType: TGMString): TGMString;

function GMXmlParseAttributesToInt(const Value: TGMXmlParseAttributes): LongInt;
function GMXmlParseAttributesFromInt(const Value: LongInt): TGMXmlParseAttributes;

function GMIsHtmlSingleToken(const ANodeName: TGMString): Boolean;

function GMXmlQualifiedName(const ANameSpace, AName: TGMString): TGMString;
function GMXmlAttrQuote(const AValue: TGMString): TGMString;

function GMGetXmlNodeAttrValueIntoVar(const ANode: IGMXmlNode; const AAttributeName: TGMString; var AAttributeValue: TGMString): Boolean;
function GMGetXmlNodeAttrValue(const ANode: IGMXmlNode; const AAttributeName: TGMString; const ADefaultValue: TGMString = ''): TGMString;
function GMCheckGetXmlNodeAttrValue(const ANode: IGMXmlNode; const AAttributeName: TGMString): TGMString;

procedure GMReadHtmlFormValues(const AFormRootNode: IGMXmlNode; const AFormValues: IGMIntfCollection);

// ---- Parsing Helper Routines ---- //
//function GMExtractXmlName(const Token: TGMString): TGMString;
//function GMXmlTokenKind(const AToken: TGMString): TXmlTokenKind;
//function GMIsXmlCommentStartToken(const Token: TGMString): Boolean;
//function GMIsXmlCommentEndToken(const Token: TGMString): Boolean;


const

  cXmlNameSpaceSep = ':';
  cXmlCommentStart = '<!--';
  cXmlCommentEnd = '-->';

  cStrXml = 'xml'; // <- must be lowercase!
  cStrXmlns = 'xmlns';
  cHtmlBody = 'body';
  //cStrXmlSep = cWhiteSpace + '.-+#:,;=?/\!$%&';
  cStrEncoding = 'encoding'; // <- must be lowercase!

  cStrForm = 'form';
  cStrAction = 'action';
  cStrInput = 'input';  // <- HTML forms
  cStrName = 'name';    // <- HTML forms
  cStrValue = 'value';  // <- HTML forms
  cStrDisabled = 'disabled'; // <- HTML forms

  cEncodingUtf8 = 'utf-8';
  cEncodingWin1252 = 'Windows-1252';
  cEncodingISO_8859_1 = 'ISO-8859-1';

  cStrHttpContentXml = 'text/xml';
  cSpecialNodeChars: set of AnsiChar = ['?', '!'];
  cWhiteChars: set of AnsiChar = [' ', #9, #10, #13];
  cStrRootNodeToken = '<Root Parser="GM-Xml"/>';

  cXmlNamedCharReplacements: array [0..136] of TStringReplaceRec =
   ((SearchStr: 'lt'; Replacement: '<'), (SearchStr: 'gt'; Replacement: '>'), (SearchStr: 'quot'; Replacement: '"'),
    (SearchStr: 'amp'; Replacement: '&'), (SearchStr: 'nbsp'; Replacement: ' '), (SearchStr: 'iexcl'; Replacement: '¡'),
    (SearchStr: 'cent'; Replacement: '¢'), (SearchStr: 'pound'; Replacement: '£'), (SearchStr: 'curren'; Replacement: '¤'),
    (SearchStr: 'yen'; Replacement: '¥'), (SearchStr: 'brvbar'; Replacement: '¦'), (SearchStr: 'sect'; Replacement: '§'),
    (SearchStr: 'uml'; Replacement: '¨'), (SearchStr: 'copy'; Replacement: '©'), (SearchStr: 'ordf'; Replacement: 'ª'),
    (SearchStr: 'laquo'; Replacement: '«'), (SearchStr: 'not'; Replacement: '¬'), (SearchStr: 'shy'; Replacement: '-'),
    (SearchStr: 'reg'; Replacement: '®'), (SearchStr: 'macr'; Replacement: '¯'), (SearchStr: 'deg'; Replacement: '°'),
    (SearchStr: 'plusmn'; Replacement: '±'), (SearchStr: 'sup2'; Replacement: '²'), (SearchStr: 'sup3'; Replacement: '³'),
    (SearchStr: 'acute'; Replacement: '´'), (SearchStr: 'micro'; Replacement: 'µ'), (SearchStr: 'para'; Replacement: '¶'),
    (SearchStr: 'middot'; Replacement: '·'), (SearchStr: 'cedil'; Replacement: '¸'), (SearchStr: 'sup1'; Replacement: '¹'),
    (SearchStr: 'ordm'; Replacement: 'º'), (SearchStr: 'raquo'; Replacement: '»'), (SearchStr: 'frac14'; Replacement: '¼'),
    (SearchStr: 'frac12'; Replacement: '½'), (SearchStr: 'frac34'; Replacement: '¾'), (SearchStr: 'iquest'; Replacement: '¿'),
    (SearchStr: 'Agrave'; Replacement: 'À'), (SearchStr: 'Aacute'; Replacement: 'Á'), (SearchStr: 'Acirc'; Replacement: 'Â'),
    (SearchStr: 'Atilde'; Replacement: 'Ã'), (SearchStr: 'Auml'; Replacement: 'Ä'), (SearchStr: 'Aring'; Replacement: 'Å'),
    (SearchStr: 'AElig'; Replacement: 'Æ'), (SearchStr: 'Ccedil'; Replacement: 'Ç'), (SearchStr: 'Egrave'; Replacement: 'È'),
    (SearchStr: 'Eacute'; Replacement: 'É'), (SearchStr: 'Ecirc'; Replacement: 'Ê'), (SearchStr: 'Euml'; Replacement: 'Ë'),
    (SearchStr: 'Igrave'; Replacement: 'Ì'), (SearchStr: 'Iacute'; Replacement: 'Í'), (SearchStr: 'Icirc'; Replacement: 'Î'),
    (SearchStr: 'Iuml'; Replacement: 'Ï'), (SearchStr: 'ETH'; Replacement: 'Ð'), (SearchStr: 'Ntilde'; Replacement: 'Ñ'),
    (SearchStr: 'Ograve'; Replacement: 'Ò'), (SearchStr: 'Oacute'; Replacement: 'Ó'), (SearchStr: 'Ocirc'; Replacement: 'Ô'),
    (SearchStr: 'Otilde'; Replacement: 'Õ'), (SearchStr: 'Ouml'; Replacement: 'Ö'), (SearchStr: 'times'; Replacement: '×'),
    (SearchStr: 'Oslash'; Replacement: 'Ø'), (SearchStr: 'Ugrave'; Replacement: 'Ù'), (SearchStr: 'Uacute'; Replacement: 'Ú'),
    (SearchStr: 'Ucirc'; Replacement: 'Û'), (SearchStr: 'Uuml'; Replacement: 'Ü'), (SearchStr: 'Yacute'; Replacement: 'Ý'),
    (SearchStr: 'THORN'; Replacement: 'Þ'), (SearchStr: 'szlig'; Replacement: 'ß'), (SearchStr: 'agrave'; Replacement: 'à'),
    (SearchStr: 'aacute'; Replacement: 'á'), (SearchStr: 'acirc'; Replacement: 'â'), (SearchStr: 'atilde'; Replacement: 'ã'),
    (SearchStr: 'auml'; Replacement: 'ä'), (SearchStr: 'aring'; Replacement: 'å'), (SearchStr: 'aelig'; Replacement: 'æ'),
    (SearchStr: 'ccedil'; Replacement: 'ç'), (SearchStr: 'egrave'; Replacement: 'è'), (SearchStr: 'eacute'; Replacement: 'é'),
    (SearchStr: 'ecirc'; Replacement: 'ê'), (SearchStr: 'euml'; Replacement: 'ë'), (SearchStr: 'igrave'; Replacement: 'ì'),
    (SearchStr: 'iacute'; Replacement: 'í'), (SearchStr: 'icirc'; Replacement: 'î'), (SearchStr: 'iuml'; Replacement: 'ï'),
    (SearchStr: 'eth'; Replacement: 'ð'), (SearchStr: 'ntilde'; Replacement: 'ñ'), (SearchStr: 'ograve'; Replacement: 'ò'),
    (SearchStr: 'oacute'; Replacement: 'ó'), (SearchStr: 'ocirc'; Replacement: 'ô'), (SearchStr: 'otilde'; Replacement: 'õ'),
    (SearchStr: 'ouml'; Replacement: 'ö'), (SearchStr: 'divide'; Replacement: '÷'), (SearchStr: 'oslash'; Replacement: 'ø'),
    (SearchStr: 'ugrave'; Replacement: 'ù'), (SearchStr: 'uacute'; Replacement: 'ú'), (SearchStr: 'ucirc'; Replacement: 'û'),
    (SearchStr: 'uuml'; Replacement: 'ü'), (SearchStr: 'yacute'; Replacement: 'ý'), (SearchStr: 'thorn'; Replacement: 'þ'),
    (SearchStr: 'yuml'; Replacement: 'ÿ'),

    (SearchStr: 'minus'; Replacement: '-'), (SearchStr: 'lowast'; Replacement: '*'), (SearchStr: 'sim'; Replacement: '~'),
    (SearchStr: 'sdot'; Replacement: '·'),

    (SearchStr: 'bull'; Replacement: '•'), (SearchStr: 'prime'; Replacement: ''''), (SearchStr: 'frasl'; Replacement: '/'),
    (SearchStr: 'trade'; Replacement: '™'), (SearchStr: 'euro'; Replacement: '€'),

    (SearchStr: 'OElig'; Replacement: 'Œ'), (SearchStr: 'oelig'; Replacement: 'œ'), (SearchStr: 'Scaron'; Replacement: 'Š'),
    (SearchStr: 'scaron'; Replacement: 'š'), (SearchStr: 'Yuml'; Replacement: 'Ÿ'), (SearchStr: 'fnof'; Replacement: 'ƒ'),

    (SearchStr: 'apos'; Replacement: ''''),

    (SearchStr: 'ensp'; Replacement: ' '), (SearchStr: 'emsp'; Replacement: ' '), (SearchStr: 'thinsp'; Replacement: ' '),
    (SearchStr: 'zwnj'; Replacement: ''), (SearchStr: 'zwj'; Replacement: ''), (SearchStr: 'ndash'; Replacement: '–'),
    (SearchStr: 'mdash'; Replacement: '—'), (SearchStr: 'lsquo'; Replacement: '‘'), (SearchStr: 'rsquo'; Replacement: '’'),
    (SearchStr: 'sbquo'; Replacement: '‚'), (SearchStr: 'ldquo'; Replacement: '“'), (SearchStr: 'rdquo'; Replacement: '”'),
    (SearchStr: 'bdquo'; Replacement: '„'), (SearchStr: 'dagger'; Replacement: '†'), (SearchStr: 'Dagger'; Replacement: '‡'),
    (SearchStr: 'hellip'; Replacement: '…'), (SearchStr: 'permil'; Replacement: '‰'), (SearchStr: 'lsaquo'; Replacement: '‹'),
    (SearchStr: 'rsaquo'; Replacement: '›'),

    (SearchStr: 'circ'; Replacement: 'ˆ'), (SearchStr: 'tilde'; Replacement: '˜'));


  cHtmlSingleTokens: array [0..12] of TGMString = ('area', 'base', 'basefont', 'br', 'col', 'frame', 'hr', 'img', 'input', 'isindex', 'link', 'meta', 'param');

  cXmlCharCodings: array [TXmlCharCoding] of TGMString = ('', cEncodingUtf8, cEncodingWin1252, cEncodingISO_8859_1);



implementation

uses Sysutils//, GMCharCoding
     {$IFNDEF FPC}{$IFDEF JEDIAPI}, JwaWinType{$ENDIF}{$ENDIF}
     {$IFDEF DELPHI6}, Variants {$ENDIF}
     ;

const

  //cStrXmlNodeToken = '<?xml version="1.0" encoding="utf-8"?>';
  cStrXmlNodeV1Token = '<?xml version="1.0"?>';


var

  vCSCreateXmlNamedCharReplacements: IGMCriticalSection = nil;
  vXmlNamedCharReplacements: IGMIntfCollection = nil;


resourcestring

  //RStrMissingStart = 'XML elements must start with "<"';
  RStrNoXMLNodeOwner = 'Cannot create a XML node without owner';
  RStrInvalidXmlToken = 'Invalid XML Token: %s';
  RStrXMLCloseMissing = 'The following XML elements have not been closed: %s';
  RStrInvalidCloseMatch = 'Closing XML token "%s" doesn''t match opening token "%s"';
  RStrNoXmlToken = 'A XML document must begin with a <?XML .. ?> element';
  RStrCantFindSubNodeFmt = 'Cannot find XML subnode "%s" of XML node "%s"';
  RStrWithAttributes = 'with attributes';
  RStrMissingCloseChar = 'Missing ">" character';
  RStrXmlNode = 'The XML node argument';
  RStrCurrentNode = 'The currently parsed XML node';
  RStrAtributeNameEmpty = 'No XML attribute name specified';
  RStrAttrNotFoundFmt = 'Attribute "%s" of XML node "%s" not found';

  RStrbjoAnd = 'AND';
  RStrbjoOr = 'OR';


type

  TNodeFindDataObj = class;

  INodeFindDataObj = interface
    ['{1D04E567-655B-4C0D-A59E-5D477ECC9F79}']
    function Obj: TNodeFindDataObj;
  end;

  TNodeFindDataObj = class(TGMRefCountedObj, INodeFindDataObj)
   public
    NodeName: TGMString;
    Attributes: IGMAttributeSearchData;
    constructor Create(const ANodeName: TGMString; const AAttributes: IGMAttributeSearchData; const ARefLifeTime: Boolean = True); reintroduce; overload;
    function Obj: TNodeFindDataObj;
  end;


  IGetReplacement = interface(IUnknown)
    ['{289EA6C7-EB98-4E28-B6FF-AFB3DBB35031}']
    function GetReplacement: TGMString;
  end;

  TGMStrReplaceObj = class(TGMNameObj, IGetReplacement)
   protected
    FReplacement: TGMString;
   public
    constructor Create(const AReplaceRec: TStringReplaceRec; const ARefLifeTime: Boolean = True); reintroduce; overload;
    function GetReplacement: TGMString;
  end;


  THtmlFormValueIteratorObj = class;

  IHtmlFormValueIteratorObj = interface
    function Obj: THtmlFormValueIteratorObj;
  end;

  THtmlFormValueIteratorObj = class(TGMRefCountedObj, IHtmlFormValueIteratorObj)
   protected
    FFormValues: IGMIntfCollection;

   public
    constructor Create(const AFormValues: IGMIntfCollection; const ARefLifeTime: Boolean = True); reintroduce; overload;
    function AddHttpFormValue(const ANode: IGMXmlNode; const AFlags: TXmlSearchFlags = cDfltXmlSearchFlags; const AParameter: IUnknown = nil): Boolean;
    function Obj: THtmlFormValueIteratorObj;
  end;



{ ------------------------- }
{ ---- Global Routines ---- }
{ ------------------------- }

function GMExtractXmlName(const Token: TGMString): TGMString; {$IFDEF DELPHI9}inline;{$ENDIF}
var chPos: PtrInt;
begin
  //Token := GMStrip(Token, cWhiteSpace);
  chPos := 1;
  while GMIsDelimiter('</?!', Token, chPos) do Inc(chPos);
  Result := GMNextWord(chPos, Token, cWhiteSpace + '!?/>');
end;

function GMXmlTokenKind(const AToken: TGMString): TXmlTokenKind; {$IFDEF DELPHI9}inline;{$ENDIF}
begin
  //AToken := GMStrip(AToken, cWhiteSpace);
  if Length(AToken) <= 2 then Result := tkUnknown
  else
   case AToken[2] of
    '/': Result := tkEnd;
    '?', '!': Result := tkSingle;
    else
     if AToken[Length(AToken)-1] = '/' then Result := tkSingle else Result := tkStart;
   end;
end;

function GMIsXmlCommentStartToken(const Token: TGMString): Boolean;
begin
  Result := GMSameText(cXmlCommentStart, Copy(Token, 1, Length(cXmlCommentStart)));
end;

function GMIsXmlCommentEndToken(const Token: TGMString): Boolean;
begin
  Result := GMSameText(cXmlCommentEnd, Copy(Token, Length(Token) - Length(cXmlCommentEnd) + 1, Length(cXmlCommentEnd)));
end;

function GMXmlQualifiedName(const ANameSpace, AName: TGMString): TGMString;
begin
  Result := GMStringJoin(ANameSpace, cXmlNameSpaceSep, AName);
end;

function GMXmlAttrQuote(const AValue: TGMString): TGMString;
begin
  Result := '"' + GMStrip(AValue, '"') + '"';
end;

function GMJuntionOperatorName(const AJunctionOperator: TJunctionOperator): TGMString;
begin
  case AJunctionOperator of
   joAnd: Result := RStrbjoAnd;
   joOr:  Result := RStrbjoOr;
   else Result := '';
  end;
end;

function GMXmlNamedValueData(const AName, AValue: TGMString): TGMXmlNamedValueData;
begin
  Result.Name := AName;
  Result.Value := AValue;
end;

function GMXmlNamedCharReplacements: IGMIntfCollection;
var CriticalSectionLock: IUnknown; i: LongInt;
begin
  CriticalSectionLock := TGMCriticalSectionLock.Create(vCSCreateXmlNamedCharReplacements);
  if vXmlNamedCharReplacements = nil then
   begin
    vXmlNamedCharReplacements := TGMIntfHashTable.Create(False, GMCompareByString, True);
    for i:=Low(cXmlNamedCharReplacements) to High(cXmlNamedCharReplacements) do vXmlNamedCharReplacements.Add(TGMStrReplaceObj.Create(cXmlNamedCharReplacements[i]));
    //n := vXmlNamedCharReplacements.Count;
   end;
  Result := vXmlNamedCharReplacements;
end;

procedure ReplaceString(var AValue: AnsiString; var AChPos: LongInt; const ALen: LongInt; const AReplacement: TGMString);
begin
  Delete(AValue, AChPos, ALen);
  Insert(AReplacement, AValue, AChPos);
  Inc(AChPos, Length(AReplacement));
end;

function GMTextToXml(const AValue: AnsiString): AnsiString;
var chPos: LongInt;
begin
  Result := AValue;
  chPos := 1;
  while chPos <= Length(Result) do
   case Result[chPos] of
    '&': ReplaceString(Result, chPos, 1, '&amp;');
    '<': ReplaceString(Result, chPos, 1, '&lt;');
    '>': ReplaceString(Result, chPos, 1, '&gt;');
    '"': ReplaceString(Result, chPos, 1, '&quot;');
    '''': ReplaceString(Result, chPos, 1, '&apos;');
    #9: ReplaceString(Result, chPos, 1, '&#x9;');
    #10: ReplaceString(Result, chPos, 1, '&#xa;');
    #13: ReplaceString(Result, chPos, 1, '&#xd;');
    else Inc(chPos);
   end;
end;

function GMFindXmlNamedCharReplacement(const AUmlStr: TGMString; var AReplacement: TGMString): Boolean;
var searchName, unkNode: IUnknown; replacement: IGetReplacement; numStr: TGMString; chCode: LongInt;
begin
  Result := False;
  if Length(AUmlStr) <= 0 then Exit;

  if {(Length(AUmlStr) > 0) and} (AUmlStr[1] = '#') then
   begin
    if (Length(AUmlStr) > 1) and (AUmlStr[2] = 'x') then
     begin
      numStr := GMDeleteChars(AUmlStr, '0123456789abcdefABCDEF', True);
      if Length(numStr) > 0 then numStr := '$' + numStr;
     end
    else numStr := GMDeleteChars(AUmlStr, '0123456789', True);

    if Length(numStr) > 0 then
     begin
      chCode := GMStrToInt(numStr);
      if GMIsInRange(chCode, 0, 255) then begin AReplacement := Chr(chCode); Result := True; end;
     end;
   end
  else
   begin
    searchName := TGMNameObj.Create(AUmlStr);
    if GMXmlNamedCharReplacements.Find(searchName, unkNode) and GMQueryInterface(unkNode, IGetReplacement, replacement) then
     begin
      AReplacement := replacement.GetReplacement;
      Result := True;
     end;
   end;
end;

function GMXmlToText(const AValue: AnsiString): AnsiString;
var chPos, subStrStart, subStrLen: LongInt; pChStart, pChEnd: PAnsiChar; replacement: TGMString;
begin
  Result := AValue;
  chPos := 1;
  repeat
   pChStart := GMStrLScanA(PAnsiChar(Result) + chPos - 1, '&', Length(Result) - chPos + 1);
   if pChStart <> nil then
    begin
     pChEnd := GMStrLScanA(pChStart + 1, ';', PAnsiChar(Result) + Length(Result) - pChStart);
     if pChEnd = nil then Break else
      begin
       replacement := '';
       subStrStart := pChStart - PAnsiChar(Result) + 1;
       subStrLen := pChEnd - pChStart;
       if (subStrLen > 1) and GMFindXmlNamedCharReplacement(Copy(Result, subStrStart+1, subStrLen-1), replacement) then
        begin
         chPos := subStrStart;
         ReplaceString(Result, chPos, subStrLen+1, replacement);
        end
       else chPos := subStrStart + 1; // Inc(chPos); //Inc(chPos, pChEnd - PAnsiChar(Result) + chPos);
      end;
    end;
  until pChStart = nil;
end;

function GMXmlParseAttributesToInt(const Value: TGMXmlParseAttributes): LongInt;
var i: TGMXmlParseAttribute;
begin
  Result := 0;
  for i:=Low(i) to High(i) do if i in Value then Result := Result or (1 shl Ord(i));
end;

function GMXmlParseAttributesFromInt(const Value: LongInt): TGMXmlParseAttributes;
var i: TGMXmlParseAttribute;
begin
  Result := [];
  for i:=Low(i) to High(i) do if Value and (1 shl Ord(i)) <> 0 then Include(Result, i);
end;

function GMFindXmlSubValue(AStartNode: IGMXmlNode; const AName: TGMString; const AAttributes: IGMAttributeSearchData; const ADefaultValue: TGMString; const ADepth: Integer): TGMString;
begin
  if AStartNode = nil then Result := ADefaultValue else
   begin
    AStartNode := AStartNode.Obj.FindSubNode(AName, AAttributes, ADepth);
    if AStartNode = nil then Result := ADefaultValue else Result := AStartNode.Obj.GetStringValue;
   end;
end;

function GMCheckFindXmlSubValue(const AStartNode: IGMXmlNode; const AName: TGMString; const AAttributes: IGMAttributeSearchData; const ADepth: Integer): TGMString;
begin
//if AStartNode = nil then raise EGMXmlException.ObjError(MsgPointerIsNil(RStrXmlNode), nil, 'GMCheckFindXmlSubValue');
  GMCheckPointerAssigned(Pointer(AStartNode), RStrXmlNode, nil, 'GMCheckFindXmlSubValue');
  Result := AStartNode.Obj.CheckFindSubNode(AName, AAttributes, ADepth).Obj.GetStringValue;
end;

function GMCheckGetXmlNodeByPath(const AStartNode: IGMXmlNode; const APath: array of TGMString): IGMXmlNode;
var i: Integer;
begin
  GMCheckPointerAssigned(Pointer(AStartNode), RStrXmlNode, nil, 'GMCheckGetXmlNodeByPath');
  Result := AStartNode;
  for i:=Low(APath) to High(APath) do Result := Result.Obj.CheckFindSubNode(APath[i], nil, 1);
end;

function GMBuildXmlNodePath(AXmlNode: IGMXmlNode): TGMString;
begin
  Result := '';
//while AXmlNode <> nil do
// begin
    Result := GMStringJoin(GMGetIntfName(AXmlNode), '.', Result)
// AXmlNode := AXmlNode.Parent;
// end;
end;

function GMGetXmlNodeByPath(const ASartNode: IGMXmlNode; const APath: array of TGMString; var AFoundNode: IGMXmlNode): Boolean;
var i: Integer;
begin
  if ASartNode = nil then begin Result := False; Exit; end;
  AFoundNode := ASartNode; Result := True;
  for i:=Low(APath) to High(APath) do
   begin
    Result := AFoundNode.Obj.FindSubNodeIntoVar(APath[i], nil, AFoundNode, 1);
    if not Result then begin AFoundNode := nil; Break; end;
   end;
end;

function GMCreateXmlNode(const AParentNode: IGMXmlNode; const AName: TGMString; const AValue: TGMString = ''; const ANameSpace: TGMString = ''; const ANodeInsertPos: TXmlNodeInsertPos = ipEnd): IGMXmlNode;
begin
  if AParentNode <> nil then
     Result := AParentNode.Obj.Owner.CreateNewNode(AParentNode, AName, AValue, ANameSpace, ANodeInsertPos);
end;

function GMIsHtmlSingleToken(const ANodeName: TGMString): Boolean;
begin
  Result := GMIsOneOfStrings(ANodeName, cHtmlSingleTokens);
end;

function GMGetXmlNodeAttrValueIntoVar(const ANode: IGMXmlNode; const AAttributeName: TGMString; var AAttributeValue: TGMString): Boolean;
var searchName, unkAttr: IUnknown; getStrVal: IGMGetStringValue; // sss: TGMString;
begin
  if (ANode = nil) or (Length(AAttributeName) <= 0) then Result := False else
   begin
    //sss := GMSeparatedNames(ANode.Obj.Attributes);
    searchName := TGMNameObj.Create(AAttributeName);
    if not ANode.Obj.Attributes.Find(searchName, unkAttr) or not GMQueryInterface(unkAttr, IGMGetStringValue, getStrVal) then Result := False else
     begin
      AAttributeValue := GMRemoveQuotes(getStrVal.StringValue);
      Result := True;
     end;
   end;
end;

function GMGetXmlNodeAttrValue(const ANode: IGMXmlNode; const AAttributeName: TGMString; const ADefaultValue: TGMString = ''): TGMString;
begin
  Result := '';
  if not GMGetXmlNodeAttrValueIntoVar(ANode, AAttributeName, Result) then Result := ADefaultValue;
end;

function GMCheckGetXmlNodeAttrValue(const ANode: IGMXmlNode; const AAttributeName: TGMString): TGMString;
const cStrRoutineName = 'GMCheckGetXmlNodeAttrValue';
//var searchName, unkAttr: IUnknown; getVal: IGMGetStringValue;
begin
  Result := '';
  GMCheckPointerAssigned(Pointer(ANode), RStrXmlNode, nil, cStrRoutineName);
  if Length(AAttributeName) <= 0 then raise EGMXmlException.ObjError(RStrAtributeNameEmpty, nil, cStrRoutineName);

  if not GMGetXmlNodeAttrValueIntoVar(ANode, AAttributeName, Result) then
     raise EGMXmlException.ObjError(GMFormat(RStrAttrNotFoundFmt, [AAttributeName, GMBuildXmlNodePath(ANode)]), nil, cStrRoutineName)

//searchName := TGMNameObj.Create(AAttributeName);
//if not ANode.Obj.Attributes.Find(searchName, unkAttr) then
//  raise EGMXmlException.ObjError(GMFormat(RStrAttrNotFoundFmt, [AAttributeName, GMBuildXmlNodePath(ANode)]), nil, cStrRoutineName)
//else
// begin
//  GMCheckQueryInterface(unkAttr, IGMGetStringValue, getVal, cStrRoutineName);
//  Result := GMRemoveQuotes(GMVarToStr(getVal.Value));
// end;
end;


//function GMGetSubNodeValue(const ANode: IGMXmlNode; const ASubNodeName: TGMString; const AMustExist: Boolean; const ADepth: LongInt = cInfiniteSearchDepth; const ADefaultValue: TGMString = ''): TGMString;
//var ValNode: IGMXmlNode;
//begin
//Result := ADefaultValue;
//if ANode = nil then Exit;
//if AMustExist then
// begin
//  ValNode := ANode.CheckFindSubNode(ASubNodeName, ADepth);
//  Result := ValNode.Value;
// end
//else
// if ANode.FindSUbNode(ASubNodeName, ValNode, ADepth) then Result := ValNode.Value;
//end;


{ -------------------------------------- }
{ ---- Complex XML parsing routines ---- }
{ -------------------------------------- }

procedure GMTraceXml(const AXml: IGMXmlTree; const AIndent: TGMString);
var traceStream: IStream; tracePrefix: TGMTracePrefix;
begin
  if (AXml = nil) or not vfGMDoTracing then Exit;
  traceStream := TGMAnsiStringIStream.Create;
  AXml.Obj.SaveToStream(traceStream, AIndent);
  if AXml.Obj is TGMHtmlTree then tracePrefix := tpHtml else tracePrefix := tpXml;
  GMTrace(GMGetIntfText(traceStream), tracePrefix);
end;

function GMExtractHtmlText(const AHtmlTree: IGMXmlTree): TGMString;
var bodyNode: IGMXmlNode;
  function ExtractHtmlTextElements(const AParentNode: IGMXmlNode): TGMString;
  var unkNode: IUnknown; xmlNode: IGMXmlNode; it: IGMIterator; nodeStrVal: TGMString; insertPos, insertOffs: LongInt;
  begin
    if AParentNode = nil then begin Result := ''; Exit; end;

    if GMIsOneOfStrings(AParentNode.Obj.Name, ['h1', 'h2', 'h3', 'h4', 'p', 'li', 'td', 'a', 'b', 'i', 'u', 'bold', 'italic', 'underline', 'font']) then
     Result := AParentNode.Obj.GetStringValue
    else
     Result := '';

    insertOffs := 0;
    it := AParentNode.Obj.SubNodes.CreateIterator;
    while it.NextEntry(unkNode) do
     if GMQueryInterface(unkNode, IGMXmlNode, xmlNode) then
      begin
       nodeStrVal := ExtractHtmlTextElements(xmlNode);

       if xmlNode.Obj.ParentValueChPos < 0 then insertPos := Length(Result)+1 else insertPos := xmlNode.Obj.ParentValueChPos+1+insertOffs;
       insertPos := GMBoundedInt(insertPos, 1, Length(Result)+1);

       if (Length(nodeStrVal) > 0) and (insertPos > 1) and not GMIsDelimiter(cWhiteSpace, Result, insertPos-1) then
        nodeStrVal := ' ' + nodeStrVal;

       if GMIsOneOfStrings(xmlNode.Obj.Name, ['li']) then nodeStrVal := ' - ' + nodeStrVal + cNewLine
       else
       if GMIsOneOfStrings(xmlNode.Obj.Name, ['h1', 'h2', 'h3', 'h4', 'p', 'tr', 'br']) then nodeStrVal := nodeStrVal + cNewLine
       else
       if GMIsOneOfStrings(xmlNode.Obj.Name, ['td']) then nodeStrVal := nodeStrVal + #9;

       Insert(nodeStrVal, Result, insertPos);
       Inc(insertOffs, Length(nodeStrVal));
      end;
  end;
begin
  if (AHtmlTree <> nil) and AHtmlTree.Obj.RootNode.Obj.FindSubNodeIntoVar(cHtmlBody, nil, bodyNode) then Result := ExtractHtmlTextElements(bodyNode) else Result := '';
end;

function HtmlCharCodingFromContent(const AContentValue: TGMString): TXmlCharCoding;
var c: TXmlCharCoding; valChPos, tokenChPos: PtrInt; token, name, val: TGMString;
begin
  Result := ccUnknown;
  if Length(AContentValue) <= 0 then Exit;

  valChPos := 1;
  repeat
   token := GMStrip(GMNextWord(valChPos, AContentValue, ';'));
   tokenChPos:=1;
   name := GMStrip(GMNextWord(tokenChPos, token, '='));
   if GMsameText(name, 'charset') then
    begin
     val := Copy(token, tokenChPos, Length(token)-tokenChPos+1);
     if Length(val) > 0 then
       for c:=Low(cXmlCharCodings) to High(cXmlCharCodings) do
         if GMSameText(val, cXmlCharCodings[c]) then begin Result := c; Exit; end;
    end;
  until Length(token) <= 0;
end;

function EvalHtmlCharCoding(const AHtmlTree: IGMXmlTree): TXmlCharCoding;
  function EvalNode(const ANode: IGMXmlNode): TXmlCharCoding;
  var it: IGMIterator; unkNode: IUnknown; childNode: IGMXmlNode;
  begin
    Result := ccUnknown;
    if ANode = nil then Exit;

    if GMSameText(ANode.Obj.Name, 'meta') then
       Result := HtmlCharCodingFromContent(GMGetXmlNodeAttrValue(ANode, 'content'));

    if Result = ccUnknown then
     begin
      it := ANode.Obj.SubNodes.CreateIterator;
      while it.NextEntry(unkNode) do
       if GMQueryInterface(unkNode, IGMXmlNode, childNode) then
        begin
         Result := EvalNode(childNode);
         if Result <> ccUnknown then Break;
        end;
     end;
  end;
begin
  if AHtmlTree <> nil then Result := EvalNode(AHtmlTree.Obj.RootNode) else Result := ccUnknown;
end;

function GMExtractAnyTextResponse(const AResponseContent: ISequentialStream; const AContentType: TGMString): TGMString;
const cStrHttpContentSep = cWhiteSpace + '/\,;:';
var chPos: PtrInt; SubType: TGMString; xmlTree: IGMXmlTree; seekStrm: IStream; streamPosKeeper: IUnknown;
begin
  if AResponseContent = nil then Exit('');

  if GMQueryInterface(AResponseContent, IStream, seekStrm) then streamPosKeeper := TGMIStreamPosKeeper.Create(seekStrm);

  chPos := 1;
  if GMSameText(GMNextWord(chPos, AContentType, cStrHttpContentSep), 'text') then
   begin
    SubType := GMNextWord(chPos, AContentType, cStrHttpContentSep);

    if GMSameText(SubType, 'plain') then Result := GMIStreamContentAsString(AResponseContent)
    else
    if GMSameText(SubType, 'html') then
     begin
      xmlTree := TGMHtmlTree.CreateRead(AResponseContent, cRelaxedHtmlParseAttributes);
      xmlTree.Obj.CharCoding := EvalHtmlCharCoding(xmlTree);
      Result := GMExtractHtmlText(xmlTree);
     end;
   end;
end;

procedure GMReadHtmlFormValues(const AFormRootNode: IGMXmlNode; const AFormValues: IGMIntfCollection);
var iteratorSink: IHtmlFormValueIteratorObj;
begin
  if (AFormRootNode = nil) or (AFormValues = nil) then Exit;
  iteratorSink := THtmlFormValueIteratorObj.Create(AFormValues);
  AFormRootNode.Obj.IterateSubNodes(iteratorSink.Obj.AddHttpFormValue);
end;


{ -------------------------------- }
{ ---- TGMAttributeSearchData ---- }
{ -------------------------------- }

constructor TGMAttributeSearchData.Create(const AAttributeValues: array of TGMXmlNamedValueData; const AJunctionOperator: TJunctionOperator; const ARefLifeTime: Boolean);
var i: Integer;
begin
  inherited Create(ARefLifeTime);
  JunctionOperator := AJunctionOperator;
  SetLength(AttributeValues, Length(AAttributeValues));
  for i:=Low(AAttributeValues) to High(AAttributeValues) do AttributeValues[i] := AAttributeValues[i];
end;

function TGMAttributeSearchData.Obj: TGMAttributeSearchData;
begin
  Result := Self;
end;


{ -------------------------- }
{ ---- TNodeFindDataObj ---- }
{ -------------------------- }

constructor TNodeFindDataObj.Create(const ANodeName: TGMString; const AAttributes: IGMAttributeSearchData; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  NodeName := ANodeName;
  Attributes := AAttributes;
end;

function TNodeFindDataObj.Obj: TNodeFindDataObj;
begin
  Result := Self;
end;


{ -------------------------- }
{ ---- TGMStrReplaceObj ---- }
{ -------------------------- }

constructor TGMStrReplaceObj.Create(const AReplaceRec: TStringReplaceRec; const ARefLifeTime: Boolean);
begin
  inherited Create(AReplaceRec.SearchStr, ARefLifeTime);
  FReplacement := AReplaceRec.Replacement;
end;

function TGMStrReplaceObj.GetReplacement: TGMString;
begin
  Result := FReplacement;
end;


{ ----------------------------------- }
{ ---- THtmlFormValueIteratorObj ---- }
{ ----------------------------------- }

constructor THtmlFormValueIteratorObj.Create(const AFormValues: IGMIntfCollection; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FFormValues := AFormValues;
end;

function THtmlFormValueIteratorObj.Obj: THtmlFormValueIteratorObj;
begin
  Result := Self;
end;

function THtmlFormValueIteratorObj.AddHttpFormValue(const ANode: IGMXmlNode; const AFlags: TXmlSearchFlags; const AParameter: IUnknown): Boolean;
var name, value: TGMString; disabled: Boolean; searchName: IUnknown;
begin
  Result := True;
  if (ANode <> nil) and GMSameText(ANode.Obj.Name, cStrInput) and (FFormValues <> nil) then
   begin
    name := GMGetXmlNodeAttrValue(ANode, cStrName);
    value := GMGetXmlNodeAttrValue(ANode, cStrValue);

    searchName := TGMNameObj.Create(cStrDisabled);
    disabled := GMCollectionContains(ANode.Obj.Attributes, searchName);

    if not disabled and (Length(name) > 0) then FFormValues.Add(TGMNameAndStrValueObj.Create(name, value)); // and (Length(value) > 0)
   end;
end;


{ -------------------- }
{ ---- TGMXmlNode ---- }
{ -------------------- }

constructor TGMXmlNode.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FSubNodes:= TGMIntfArrayCollection.Create(True, False, nil, True);
  FAttributes := TGMIntfArrayCollection.Create(False, False, GMCompareByName);
end;

constructor TGMXmlNode.Create(const AOwner: TGMXmlTree; const AParent: IGMXmlNode; const AToken: AnsiString; const ANodeInsertPos: TXmlNodeInsertPos; const AParentValueChPos: LongInt);
begin
  if AOwner = nil then raise EGMXmlException.ObjError(RStrNoXMLNodeOwner, Self);
  inherited Create('', Unassigned, True);
  FOwner := AOwner;
  FParent := GMObjFromIntf(AParent) as TGMXmlNode;
  FParentValueChPos := AParentValueChPos;
  if AParent <> nil then
   case ANodeInsertPos of
    ipBegin: AParent.Obj.SubNodes.Insert(Self, 0);
    ipEnd:   AParent.Obj.SubNodes.Add(Self);
   end;

  if AToken <> '' then ParseXmlToken(AToken);
end;

constructor TGMXmlNode.CreateNew(const AOwner: TGMXmlTree; const AParent: IGMXmlNode; const AName, AValue: TGMString; const ANameSpace: TGMString; const ANodeInsertPos: TXmlNodeInsertPos);
begin
  Create(AOwner, AParent, '', ANodeInsertPos, -1);
  FName := AName;
  StrValue := AValue; // <- route through overriden SetStrValue method!
  FNameSpace := ANameSpace;
end;

//destructor TGMXmlNode.Destroy;
//begin
//GMFreeAndNil(FAttributes);
//inherited Destroy;
//end;

function TGMXmlNode.Obj: TGMXmlNode;
begin
  Result := Self;
end;

//procedure TGMXmlNode.Remove;
//begin
//if Parent <> nil then Parent.Obj.SubNodes.RemoveByKey(Self); // <- will free us!
//end;

function TGMXmlNode.AttributeCreateClass: TGmXmlAttributeClass;
begin
  Result := TGMXmlAttribute;
end;

function TGMXmlNode.GetStringValue: TGMString;
begin
  Result := Owner.DecodeNodeValue(PlainValue);
end;

procedure TGMXmlNode.SetStringValue(const AStrValue: TGMString);
begin
  PlainValue := Owner.EncodeNodeValue(AStrValue);
end;

function TGMXmlNode.GetUnionValue: RGMUnionValue;
begin
  Result := GetStringValue;
end;

procedure TGMXmlNode.SetUnionValue(const AValue: RGMUnionValue);
begin
  SetStringValue(AValue);
end;

function TGMXmlNode.GetPlainValue: TGMString;
begin
  Result := FStrValue; // <- dont route through virtual inherited call here!
end;

procedure TGMXmlNode.SetPlainValue(const APlainValue: TGMString);
begin
  FStrValue := APlainValue; // <- dont route through virtual inherited call here!
end;

function TGMXmlNode.GetParent: IGMXmlNode;
begin
  GMGetInterface(FParent, IGMXmlNode, Result);
end;

procedure TGMXmlNode.DumpContent(const AIndent, AIndentAppend: TGMString; const ADumpLineProc: TDumpLineProc; const AAppData: Pointer; const ARecurse: Boolean);
var it: IGMIterator; unkNode: IUnknown; childNode: IGMXmlNode; txt: TGMString;
begin
  if not Assigned(ADumpLineProc) then Exit;

  txt := GetStringValue;
  if Length(txt) <= 0 then ADumpLineProc(cNewLine, AAppData);

  txt := AIndent + GMStringJoin(GMStringJoin(NameSpace, '.', Name), ': ', GMStringJoin(txt, ', Attr: ', GMNamesAndValuesAsString(Attributes, GMUnionValueAsString, ', ', '=')));
  if SubNodes.Count > 0 then txt := txt  + ':';
  txt := txt + cNewLine;

  ADumpLineProc(txt, AAppData);
  if ARecurse then
   begin
    it := SubNodes.CreateIterator;
    while it.NextEntry(unkNode) do
     if GMQueryInterface(unkNode, IGMXmlNode, childNode) then
        childNode.Obj.DumpContent(AIndent + AIndentAppend, AIndentAppend, ADumpLineProc, AAppData, ARecurse);
   end;
end;

function TGMXmlNode.BuildSingleNodeOutputStr(const ANSName, ANSNameWithAttr, AValStr: TGMString): TGMString;
begin
  if Length(AValStr) <= 0 then Result := GMFormat('<%s />', [ANSNameWithAttr]) else Result := GMFormat('<%s>%s</%s>', [ANSNameWithAttr, AValStr, ANSName]);
end;

procedure TGMXmlNode.SaveToStream(const AIndent, AIndentAppend: AnsiString; const ADest: ISequentialStream; const ARecurse: Boolean);
var nsAttrName, nsName: TGMString; it: IGMIterator; unkNode: IUnknown; childNode: IGMXmlNode;
  procedure WriteLine(Line: AnsiString);
  begin
    Line := AIndent + Line + cNewLine;
    GMSafeIStreamWrite(ADest, PAnsiChar(Line), Length(Line));
    //ADest.WriteBuffer(PAnsiChar(Line)^, Length(Line));
  end;
begin
  if ADest = nil then Exit;
  nsName := GMXmlQualifiedName(NameSpace, Name);
  nsAttrName := GMStringJoin(nsName, ' ', GMNamesAndValuesAsString(Attributes, GMUnionValueAsQuotedString, ' ', '='));
  case FSpecialNodeCh of
   '?': WriteLine(GMFormat('<?%s?>', [nsAttrName]));
   '!': WriteLine(GMFormat('<!%s>', [nsAttrName]));
   else
    if SubNodes.IsEmpty or not ARecurse then
      WriteLine(BuildSingleNodeOutputStr(nsName, nsAttrName, PlainValue))
//   begin
//    valStr := PlainValue;
//    if Length(valStr) <= 0 then WriteLine(GMFormat('<%s />', [nsAttrName])) else WriteLine(GMFormat('<%s>%s</%s>', [nsAttrName, valStr, nsName]));
//   end
    else
     begin
      WriteLine(GMFormat('<%s>', [nsAttrName]));
      it := SubNodes.CreateIterator;
      while it.NextEntry(unkNode) do
        if GMQueryInterface(unkNode, IGMXmlNode, childNode) then childNode.Obj.SaveToStream(AIndent + AIndentAppend, AIndentAppend, ADest, ARecurse);
//    for i:=0 to SubNodes.Count-1 do ChildNodeByIdx(i).Obj.SaveToStream(AIndent + AIndentAppend, AIndentAppend, ADest, ARecurse);
      WriteLine(GMFormat('</%s>', [nsName]));
     end;
  end;
end;

procedure TGMXmlNode.ParseAttributes(const Content: AnsiString);
var Ch, LastCh: AnsiChar; chPos, Len: Integer; S, NameStr, valStr: AnsiString; IsValue: Boolean; PCh: PAnsiChar;
  procedure AddAndReset;
  begin
    if NameStr = '' then Exit;
    Attributes.Add(AttributeCreateClass.Create(NameStr, GMStrip(valStr, '"'), True));
    NameStr := ''; valStr := '';
  end;
  procedure TerminateWord;
  begin
    if S = '' then Exit;
    if NameStr = '' then NameStr := S else valStr := S;
    S := '';
  end;
  procedure TerminateAndAdd;
  begin
    TerminateWord;
    if not IsValue then AddAndReset else IsValue := False;
  end;
begin
  chPos := 1; NameStr := ''; valStr := ''; LastCh := #0; IsValue := False;
  while chPos <= Length(Content) do
   begin
    Ch := Content[chPos];
    case Ch of
     '"': begin
           TerminateAndAdd;
           PCh := GMStrLScanA(PAnsiChar(Content) + chPos, '"', Length(Content)-chPos);
           if PCh = nil then Len := Length(Content)-chPos else Len := PCh - PAnsiChar(Content) - chPos + 1;
           S := S + Ch + Copy(Content, chPos+1, Len);
           Inc(chPos, Len);
           Ch := Content[chPos];
          end;
     '/', '>', '?': begin TerminateWord; AddAndReset; end;
     '=': begin TerminateWord; IsValue := True; end;
     else
     if (LastCh in cWhiteChars) and not (Ch in cWhiteChars) then
      begin TerminateAndAdd; S := Ch; end
     else
      if not (Ch in cWhiteChars) then S := S + Ch;
    end;
    LastCh := Ch;
    Inc(chPos);
   end;
end;

procedure TGMXmlNode.ParseXmlToken(const AToken: AnsiString);
var chPos: PtrInt;
begin
  chPos := 1;
  while (chPos <= Length(AToken)) and (AToken[chPos] = '<') do Inc(chPos);
  if (chPos <= Length(AToken)) and (AToken[chPos] in cSpecialNodeChars) then FSpecialNodeCh := AToken[chPos] else FSpecialNodeCh := #0;
  while (chPos <= Length(AToken)) and (AToken[chPos] in ['<', '/', '?', '!'])  do Inc(chPos);
  FName := GMNextWord(chPos, AToken, cWhiteSpace + '!?/>');
  ParseAttributes(Copy(AToken, chPos, Length(AToken)-chPos+1));
  chPos := Pos(cXmlNameSpaceSep, FName);
  if chPos <> 0 then
   begin
    FNameSpace := Copy(FName, 1, chPos-1);
    FName := Copy(FName, chPos+1, Length(FName)-chPos);
   end;
end;

function TGMXmlNode.IterateSubNodes(const VisitNodeFunc: TGMXmlNodeVisitFunc; const Parameter: IUnknown;
                                    const Depth: Integer; const Flags: TXmlSearchFlags): IGMXmlNode;
  function VisitNode(const ANode: IGMXmlNode; const ALevel: Integer): IGMXmlNode;
  var it: IGMIterator; unkNode: IUnknown; childNode: IGMXmlNode;
  begin
    Result := nil;
    if ANode = nil then Exit;
    if not VisitNodeFunc(ANode, Flags, Parameter) then Result := ANode else
     if (Depth = cInfiniteSearchDepth) or (ALevel < Depth) then
      begin
       it := ANode.Obj.SubNodes.CreateIterator;
//     for i:=0 to ANode.Obj.SubNodes.Count-1 do
       while it.NextEntry(unkNode) do
        if GMQueryInterface(unkNode, IGMXmlNode, childNode) then
         begin
          Result := VisitNode(childNode, ALevel + 1);
          if Result <> nil then Break;
         end;
      end;
  end;
begin
  Result := nil;
  if not Assigned(VisitNodeFunc) then Exit;
  Result := VisitNode(Self, 0);
  if (sfNoSelf in Flags) and (Result <> nil) and (Result.Obj = Self) then Result := nil;
end;

procedure TGMXmlNode.CopyNodeTo(const ADestRoot: IGMXmlNode; const ANodeInsertPos: TXmlNodeInsertPos; const ARecurse: Boolean);
var newNode: IGMXmlNode;
begin
  if ADestRoot = nil then Exit;
  newNode := GMCreateXmlNode(ADestRoot, FName, FStrValue, NameSpace, ANodeInsertPos);
  if ARecurse then CopySubNodesTo(newNode, ANodeInsertPos, ARecurse);
end;

procedure TGMXmlNode.CopySubNodesTo(const ADestRoot: IGMXmlNode; const ANodeInsertPos: TXmlNodeInsertPos; const ARecurse: Boolean);
var childNode, newNode: IGMXmlNode; it: IGMIterator; unkNode: IUnknown;
begin
  if ADestRoot = nil then Exit;
  it := SubNodes.CreateIterator;
//for i:=0 to SubNodes.Count-1 do
  while it.NextEntry(unkNode) do
   if GMQueryInterface(unkNode, IGMXmlNode, childNode) then
   begin
    newNode := GMCreateXmlNode(ADestRoot, childNode.Obj.Name, childNode.Obj.GetStringValue, childNode.Obj.NameSpace, ANodeInsertPos);
    if ARecurse then childNode.Obj.CopySubNodesTo(newNode, ANodeInsertPos, ARecurse);
   end;
end;

function TGMXmlNode.DecideFindNode(const ANode: IGMXmlNode; const AFlags: TXmlSearchFlags; const AParameter: IUnknown): Boolean;
var findData: INodeFindDataObj;
  function _SameText(const AStr1, AStr2: TGMString): Boolean;
  begin
    if sfIgnoreCase in AFlags then Result := GMSameText(AStr1, AStr2) else Result := AStr1 = AStr2;
  end;
  function IsNameMatch: Boolean;
  begin
    Result := _SameText(ANode.Obj.Name, findData.Obj.NodeName);
  end;
  function IsAttributeMatch: Boolean;
  var i: Integer; searchName, unkAttr: IUnknown; getText: IGMGetText; hasAttr: Boolean;
  begin
//  if Length(findData.Obj.Attributes.Obj.AttributeValues) <= 0 then begin Result := False; Exit;end;
    case findData.Obj.Attributes.Obj.JunctionOperator of
     joAnd: Result := True;
     joOr:  Result := False;
     else begin Result := False; Exit; end;
    end;

    for i:=Low(findData.Obj.Attributes.Obj.AttributeValues) to High(findData.Obj.Attributes.Obj.AttributeValues) do
     begin
      searchName := TGMNameObj.Create(findData.Obj.Attributes.Obj.AttributeValues[i].Name);
      hasAttr := ANode.Obj.Attributes.Find(searchName, unkAttr) and GMQueryInterface(unkAttr, IGMGetText, getText) and
                 _SameText(GMRemoveQuotes(getText.Text), GMRemoveQuotes(findData.Obj.Attributes.Obj.AttributeValues[i].Value));

      case findData.Obj.Attributes.Obj.JunctionOperator of
       joAnd: begin Result := Result and hasAttr; if not Result then Break; end;
       joOr: begin Result := Result or hasAttr; if Result then Break; end;
      end;
     end;
  end;
begin
  // Result = True => not a match, continue search!
  if (ANode = nil) or not GMQueryInterface(AParameter, INodeFindDataObj, findData) then Result := True else
    if Length(findData.Obj.NodeName) <= 0 then
     begin
      if (findData.Obj.Attributes = nil) or (Length(findData.Obj.Attributes.Obj.AttributeValues) <= 0) then
         Result := True else Result := not IsAttributeMatch;
     end
    else
      if (findData.Obj.Attributes = nil) or (Length(findData.Obj.Attributes.Obj.AttributeValues) <= 0) then
         Result := not IsNameMatch else Result := not IsNameMatch or not IsAttributeMatch;
end;

function TGMXmlNode.FindSubNode(const AName: TGMString; const AAttributes: IGMAttributeSearchData; const ADepth: Integer; const AFlags: TXmlSearchFlags): IGMXmlNode;
var findData: INodeFindDataObj;
begin
  findData := TNodeFindDataObj.Create(AName, AAttributes);
  Result := IterateSubNodes(DecideFindNode, findData, ADepth, AFlags);
end;

function TGMXmlNode.FindSubNodeIntoVar(const AName: TGMString; const AAttributes: IGMAttributeSearchData; var AFoundNode: IGMXmlNode; const ADepth: Integer; const AFlags: TXmlSearchFlags): Boolean;
begin
  AFoundNode := FindSubNode(AName, AAttributes, ADepth, AFlags);
  Result := AFoundNode <> nil;
end;

function TGMXmlNode.CheckFindSubNode(const AName: TGMString; const AAttributes: IGMAttributeSearchData; const ADepth: Integer; const AFlags: TXmlSearchFlags): IGMXmlNode;
const cStrMethodName = 'CheckFindSubNode';
var errMsg, attrStr: TGMString; i: Integer; 
begin
  Result := FindSubNode(AName, AAttributes, ADepth, AFlags);
  if Result = nil then
   begin
    errMsg := GMFormat(RStrCantFindSubNodeFmt, [AName, Name]);

    attrStr := '';
    if (AAttributes <> nil) and (Length(AAttributes.Obj.AttributeValues) > 0) then
      for i:=Low(AAttributes.Obj.AttributeValues) to High(AAttributes.Obj.AttributeValues) do
          attrStr := GMStringJoin(attrStr, ' ' + GMJuntionOperatorName(AAttributes.Obj.JunctionOperator) + ' ', AAttributes.Obj.AttributeValues[i].Name + '="' + AAttributes.Obj.AttributeValues[i].Value + '"');

    if Length(attrStr) > 0 then errMsg := GMStringJoin(errMsg, ', ', RStrWithAttributes + ': ' + attrStr);
    raise EGMXmlException.ObjError(errMsg, Self, cStrMethodName);
   end;
end;


{ -------------------- }
{ ---- TGMXmlTree ---- }
{ -------------------- }

constructor TGMXmlTree.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FRootNode := CreateNodeFromToken(nil, cStrRootNodeToken);
  SetCharCodingAttrOfXmlNode(ccUnknown);
end;

constructor TGMXmlTree.CreateRead(
  const ASource: ISequentialStream; const AParseAttributes: TGMXmlParseAttributes;
  const AStopAtNode: TGMString; const ARefLifeTime: Boolean);
begin
  Create(ARefLifeTime);
  if ASource <> nil then ParseIStream(ASource, AParseAttributes, AStopAtNode, False);
end;

constructor TGMXmlTree.CreateWrite(const ACharCoding: TXmlCharCoding; const ARefLifeTime: Boolean);
begin
  Create(ARefLifeTime);
  CreateNodeFromToken(FRootNode, cStrXmlNodeV1Token);
  SetCharCodingAttrOfXmlNode(ACharCoding);
end;

function TGMXmlTree.Obj: TGMXmlTree;
begin
  Result := Self;
end;

function TGMXmlTree.NodeCreateClass: TGMXmlNodeClass;
begin
  Result := TGMXmlNode;
end;

procedure TGMXmlTree.SetCharCodingAttrOfXmlNode(const ACharCoding: TXmlCharCoding);
var xmlNode: IGMXmlNode; nameObj: IUnknown; attrStrVal: IGMGetSetStringValue; unkAttr: IUnknown;
begin
  if RootNode.Obj.FindSubNodeIntoVar(cStrXml, nil, xmlNode, 1) then
   begin
    nameObj := TGMNameObj.Create(cStrEncoding, True);
    case ACharCoding of
     ccUnknown: xmlNode.Obj.Attributes.RemoveByKey(nameObj);
     else
      begin
       if not xmlNode.Obj.Attributes.Find(nameObj, unkAttr) then
          unkAttr := xmlNode.Obj.Attributes.Add(xmlNode.Obj.AttributeCreateClass.Create(cStrEncoding, ''));

       GMCheckQueryInterface(unkAttr, IGMGetSetStringValue, attrStrVal);
//     attrStrVal.Value := '"' + cXmlCharCodings[ACharCoding] + '"';
       attrStrVal.SetStringValue(cXmlCharCodings[ACharCoding]);
      end;
    end;
   end;
end;

function TGMXmlTree.CreateNewNode(const AParent: IGMXmlNode; const AName: TGMString; const AValue: TGMString; const ANameSpace: TGMString; const ANodeInsertPos: TXmlNodeInsertPos): IGMXmlNode;
begin
  Result := NodeCreateClass.CreateNew(Self, AParent, AName, AValue, ANameSpace, ANodeInsertPos);
end;

function TGMXmlTree.CreateNodeFromToken(const AParent: IGMXmlNode; const AToken: AnsiString; const ANodeInsertPos: TXmlNodeInsertPos; const AParentValueChPos: LongInt): IGMXmlNode;
begin
  Result := NodeCreateClass.Create(Self, AParent, AToken, ANodeInsertPos, AParentValueChPos);
end;

function TGMXmlTree.CharCodingOfNode(const ANode: IGMXmlNode): TXmlCharCoding;
var c: TXmlCharCoding; encoding: TGMString;
begin
  if GMGetXmlNodeAttrValueIntoVar(ANode, cStrEncoding, encoding) then
    for c:=Low(c) to High(c) do
      if GMSameText(encoding, cXmlCharCodings[c]) then begin Result := c; Exit; end; // <- NOTE: Exit here!

  Result := ccUnknown;
end;

function TGMXmlTree.CharCodingInfo: TXmlCharCoding;
begin
  Result := CharCodingOfNode(RootNode.Obj.SubNodes.First as IGMXmlNode);
end;

procedure TGMXmlTree.DumpNodes(const ADumpLineProc: TDumpLineProc; const AAppData: Pointer; const AIndent: TGMString);
var it: IGMIterator; unkNode: IUnknown; childNode: IGMXmlNode;
begin
  if not Assigned(ADumpLineProc) then Exit;
  it := RootNode.Obj.SubNodes.CreateIterator;
  while it.NextEntry(unkNode) do
    if GMQueryInterface(unkNode, IGMXmlNode, childNode) then childNode.Obj.DumpContent('', AIndent, ADumpLineProc, AAppData, True);

//for i:=0 to RootNode.Obj.SubNodes.Count-1 do RootNode.Obj.ChildNodeByIdx(i).Obj.DumpContent('', AIndent, ADumpLineProc);
end;

procedure TGMXmlTree.SaveToStream(const ADest: ISequentialStream; const AIndent: TGMString);
var it: IGMIterator; unkNode: IUnknown; childNode: IGMXmlNode;
begin
  if ADest = nil then Exit;
  it := RootNode.Obj.SubNodes.CreateIterator;
  while it.NextEntry(unkNode) do
    if GMQueryInterface(unkNode, IGMXmlNode, childNode) then childNode.Obj.SaveToStream('', AIndent, ADest);

//for i:=0 to RootNode.Obj.SubNodes.Count-1 do RootNode.Obj.SubNodes[i].Obj.SaveToStream('', AIndent, ADest);
end;

function TGMXmlTree.TokenKind(const AToken: TGMString): TXmlTokenKind;
begin
  Result := GMXmlTokenKind(AToken);
end;

function TGMXmlTree.DecodeNodeValue(const AValue: AnsiString): TGMString;
var xmlstr: AnsiString;
begin
  xmlstr := GMXmlToText(AValue);
  case FCharCoding of
   ccUnknown, ccUtf8: Result := GMUtf8ToString(xmlstr);
   else Result := xmlstr;
  end;
end;

function TGMXmlTree.EncodeNodeValue(const AValue: TGMString): AnsiString;
begin
  case FCharCoding of
   ccUnknown, ccUtf8: Result := GMStringToUtf8(AValue);
   else Result := AValue;
  end;
  Result := GMTextToXml(Result);
end;

procedure TGMXmlTree.ParseIStream(const AStream: ISequentialStream; const AParseAttributes: TGMXmlParseAttributes; const AStopAtNode: TGMString; const Append: Boolean);
const cStrMethodName = 'ParseIStream'; // cBufferSize = $10000; // <- 64 KB
var token, value, comment, byteBuf: AnsiString; nodeStack: IGMIntfArrayCollection; parentChPos, bufPos: LongInt;
    node, tmpNode, currentNode: IGMXmlNode; isFirstNode: Boolean; // HasXmlToken, CodecAssigned

  function ReadStr(var ADestStr: AnsiString; const AStopCh: AnsiChar; var ABufPos: LongInt; const AIncludeStopCh: Boolean): Boolean;
  const cInc: array [Boolean] of LongInt = (0, 1);
  var PCh: PAnsiChar;
    procedure ReadMore;
    var n: LongInt;
    begin
      SetLength(byteBuf, cDfltCopyBufferSize);
      GMHrCheckObj(AStream.Read(PAnsiChar(byteBuf), Length(byteBuf), Pointer(@n)), Self, cStrMethodName); // RStrStreamRead + ': '
      if n <> Length(byteBuf) then SetLength(byteBuf, n);
      ABufPos := 0;
    end;
  begin
    Result := True;
    repeat
     PCh := GMStrLScanA(PAnsiChar(byteBuf) + ABufPos, AStopCh, Length(byteBuf) - ABufPos);
     if PCh = nil then
      begin
       ADestStr := ADestStr + Copy(byteBuf, ABufPos + 1, Length(byteBuf) - ABufPos);
       ReadMore;
      end;
     if Length(byteBuf) = 0 then begin Result := False; Exit; end; // <- End of input stream!
    until PCh <> nil;
    ADestStr := GMStrip(ADestStr + Copy(byteBuf, ABufPos + 1, PCh - PAnsiChar(byteBuf) - ABufPos + cInc[AIncludeStopCh]), cWhiteSpace);
    ABufPos := PCh - PAnsiChar(byteBuf) + cInc[AIncludeStopCh];
  end;

  procedure NextToken(var ABufPos: LongInt);
  begin
    token := ''; value := '';
    if not ReadStr(value, '<', ABufPos, False) then Exit; // <- End of input stream!
    if not ReadStr(token, '>', ABufPos, True) then raise EGMXmlException.ObjError(RStrMissingCloseChar, Self, cStrMethodName);
  end;

  procedure ProcessFirstNode(const ANode: IGMXmlNode);
  begin
    if ANode = nil then Exit;
    if (paCheckHasXmlToken in AParseAttributes) and not GMSameText(ANode.Obj.Name, cStrXml) then
     raise EGMXmlException.ObjError(RStrNoXmlToken, Self, cStrMethodName);

    FCharCoding := CharCodingOfNode(ANode);
  end;

begin
  if AStream = nil then Exit;
  if not Append then RootNode.Obj.SubNodes.Clear;
  nodeStack := TGMIntfArrayCollection.Create(True, False, nil, True);
  currentNode := RootNode; bufPos := 0; byteBuf := ''; isFirstNode := True; // HasXmlToken := False; CodecAssigned := False;
  repeat
   NextToken(bufPos);
   if Length(token) <= 0 then Break;

   if paIgnoreComments in AParseAttributes then
    begin
     if GMIsXmlCommentStartToken(token) then
      begin
       if not GMIsXmlCommentEndToken(token) then
        repeat
         // Eating input until end of comment or end of input.
         comment := '';
         if not ReadStr(comment, '>', bufPos, True) then Break; // <- End of input stream!
        until Copy(comment, Length(comment)-Length(cXmlCommentEnd)+1, Length(cXmlCommentEnd)) = cXmlCommentEnd;
       Continue;
      end;
    end;

   case TokenKind(token) of
    tkStart, tkSingle:
     begin
      //if (currentNode <> RootNode) then begin CheckHasXmlToken; AssignStringCodec; end;
      if currentNode = nil then parentChPos := 0 else
       begin
        if Length(value) > 0 then currentNode.Obj.PlainValue := currentNode.Obj.PlainValue + value;
        parentChPos := Length(currentNode.Obj.PlainValue);
       end;

      case TokenKind(token) of
       tkSingle: node := CreateNodeFromToken(currentNode, token, ipEnd, parentChPos);
       tkStart:  begin
//                node := nodeStack.Add(CreateNodeFromToken(currentNode, token, ipEnd, parentChPos)) as IGMXmlNode;
                  GMCheckQueryInterface(nodeStack.Add(CreateNodeFromToken(currentNode, token, ipEnd, parentChPos)), IGMXmlNode, node);
                  currentNode := node;
                 end;
       else node := nil;          
      end;

      if isFirstNode then begin ProcessFirstNode(node); isFirstNode := False; end;

      if (Length(AStopAtNode) > 0) and GMSameText(AStopAtNode, node.Obj.Name) then Exit;
     end;

    tkEnd:
     begin
      GMCheckPointerAssigned(Pointer(currentNode), RStrCurrentNode, Self, cStrMethodName);
      if Length(value) > 0 then currentNode.Obj.PlainValue := currentNode.Obj.PlainValue + value;

      if nodeStack.IsEmpty then Break else nodeStack.RemoveByIdx(nodeStack.Count-1);

      if (paCheckCloseMatch in AParseAttributes) and
         not GMSameText(GMXmlQualifiedName(currentNode.Obj.NameSpace, currentNode.Obj.Name), GMExtractXmlName(token)) then
        raise EGMXmlException.ObjError(GMFormat(RStrInvalidCloseMatch, [GMExtractXmlName(token), GMXmlQualifiedName(currentNode.Obj.NameSpace, currentNode.Obj.Name)]), Self, cStrMethodName);

//    currentNode := currentNode.Obj.Parent;
      if nodeStack.IsEmpty then currentNode := RootNode else GMCheckQueryInterface(nodeStack.Last, IGMXmlNode, currentNode);

     end;
    else raise EGMXmlException.ObjError(GMFormat(RStrInvalidXmlToken, [GMMakeSingleLine(token, '')]), Self, cStrMethodName);
   end;
  until False;

  if (paCheckHasXmlToken in AParseAttributes) and
     (//not (RootNode.Obj.SubNodes.First is IGMXmlNode)
       not GMQueryInterface(RootNode.Obj.SubNodes.First, IGMXmlNode, tmpNode) or not GMSameText(tmpNode.Obj.Name, cStrXml)) then


   raise EGMXmlException.ObjError(RStrNoXmlToken, Self, cStrMethodName);

  if (paCheckAllClosed in AParseAttributes) and not nodeStack.IsEmpty then
   raise EGMXmlException.ObjError(GMFormat(RStrXMLCloseMissing, [GMSeparatedNames(nodeStack)]), Self, cStrMethodName);
end;


{ --------------------- }
{ ---- TGMHtmlNode ---- }
{ --------------------- }

function TGMHtmlNode.BuildSingleNodeOutputStr(const ANSName, ANSNameWithAttr, AValStr: TGMString): TGMString;
begin
  if ((Length(AValStr) <= 0) and GMIsHtmlSingleToken(Name)) then Result := GMFormat('<%s>', [ANSNameWithAttr]) else Result := GMFormat('<%s>%s</%s>', [ANSNameWithAttr, AValStr, ANSName]);
end;


{ --------------------- }
{ ---- TGMHtmlTree ---- }
{ --------------------- }

function TGMHtmlTree.TokenKind(const AToken: TGMString): TXmlTokenKind;
begin
  if GMIsHtmlSingleToken(GMFirstWord(GMStrip(AToken, '<>!?/\' + cWhiteSpace), cWhiteSpace)) then Result := tkSingle else Result := inherited TokenKind(AToken);
end;

function TGMHtmlTree.NodeCreateClass: TGMXmlNodeClass;
begin
  Result := TGMHtmlNode;
end;


initialization

  vCSCreateXmlNamedCharReplacements := TGMCriticalSection.Create(True);

end.