{ +-------------------------------------------------------------+ } { | | } { | GM-Software | } { | =========== | } { | | } { | Project: All Projects | } { | | } { | Description: Xml implementations. | } { | | } { | | } { | Copyright (C) - 2004 - Gerrit Moeller. | } { | | } { | Source code distributed 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} ; 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 threadSync: RGMCriticalSectionLock; i: LongInt; begin threadSync.Lock(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, '&'); '<': ReplaceString(Result, chPos, 1, '<'); '>': ReplaceString(Result, chPos, 1, '>'); '"': ReplaceString(Result, chPos, 1, '"'); '''': ReplaceString(Result, chPos, 1, '''); #9: ReplaceString(Result, chPos, 1, '	'); #10: ReplaceString(Result, chPos, 1, '
'); #13: ReplaceString(Result, chPos, 1, '
'); 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; //var searchName, unkAttr: IUnknown; getVal: IGMGetStringValue; begin Result := ''; GMCheckPointerAssigned(Pointer(ANode), RStrXmlNode, nil, {$I %CurrentRoutine%}); if Length(AAttributeName) <= 0 then raise EGMXmlException.ObjError(RStrAtributeNameEmpty, nil, {$I %CurrentRoutine%}); if not GMGetXmlNodeAttrValueIntoVar(ANode, AAttributeName, Result) then raise EGMXmlException.ObjError(GMFormat(RStrAttrNotFoundFmt, [AAttributeName, GMBuildXmlNodePath(ANode)]), nil, {$I %CurrentRoutine%}) //searchName := TGMNameObj.Create(AAttributeName); //if not ANode.Obj.Attributes.Find(searchName, unkAttr) then // raise EGMXmlException.ObjError(GMFormat(RStrAttrNotFoundFmt, [AAttributeName, GMBuildXmlNodePath(ANode)]), nil, {$I %CurrentRoutine%}) //else // begin // GMCheckQueryInterface(unkAttr, IGMGetStringValue, getVal, {$I %CurrentRoutine%}); // 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; 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, {$I %CurrentRoutine%}); 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 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, {$I %CurrentRoutine%}); // 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, {$I %CurrentRoutine%}); 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, {$I %CurrentRoutine%}); 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, {$I %CurrentRoutine%}); 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, {$I %CurrentRoutine%}); // 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, {$I %CurrentRoutine%}); 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, {$I %CurrentRoutine%}); if (paCheckAllClosed in AParseAttributes) and not nodeStack.IsEmpty then raise EGMXmlException.ObjError(GMFormat(RStrXMLCloseMissing, [GMSeparatedNames(nodeStack)]), Self, {$I %CurrentRoutine%}); 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.