unit uROXDOM_2_3; // XDOM 2.3.28 // Extended Document Object Model 2.3.28 // Delphi 3/4/5/6 and Kylix Implementation // // Copyright (c) 1999-2002 by Dieter Köhler // ("http://www.philo.de/xml/") // // Definitions: // - "Package" refers to the collection of files distributed by // the Copyright Holder, and derivatives of that collection of // files created through textual modification. // - "Standard Version" refers to such a Package if it has not // been modified, or has been modified in accordance with the // wishes of the Copyright Holder. // - "Copyright Holder" is whoever is name in the copyright or // copyrights for the package. // - "You" is you, if you're thinking about copying or distributing // this Package. // // Permission is hereby granted, free of charge, to any person // obtaining a copy of this software and associated documentation // files (the "Package"), to deal in the Package without restriction, // including without limitation the rights to use, copy, modify, // merge, publish, distribute, sublicense, and/or sell copies of the // Package, and to permit persons to whom the Package is furnished // to do so, subject to the following conditions: // // The above copyright notice and this permission notice shall be // included in all copies or substantial portions of the Package. // // You may modify your copy of this Package in any way, provided // that you insert a prominent notice in each changed file stating // how and when you changed a file, and provided that you do at // least one of the following: // // a) allow the Copyright Holder to include your modifications in // the Standard Version of the Package. // // b) use the modified Package only within your corporation or // organization. // // c) rename any non standard executables, units, and classes so // the names do not conflict with standard executables, units, and // classes, and provide a separate manual page that clearly documents // how it differs from the standard version. // // d) make other distribution arrangements with the Copyright Holder. // // The name of the Copyright Holder may not be used to endorse or // promote products derived from this Package without specific prior // written permission. // // THE PACKAGE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, // EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF // MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. // IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY // CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, // TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE // PACKAGE OR THE USE OR OTHER DEALINGS IN THE PACKAGE. {$HINTS OFF} interface {$IFDEF FPC} {$MODE DELPHI} {$ENDIF} uses uROUnicodeConv, // This version of XDOM needs the Unicode Converter Library 2.x, // available at "http://www.philo.de/xml/" Math, SysUtils, Classes, variants; type EDomException = class(Exception); EIndex_Size_Err = class(EdomException); EDomstring_Size_Err = class(EdomException); EHierarchy_Request_Err = class(EdomException); EWrong_Document_Err = class(EdomException); EInvalid_Character_Err = class(EdomException); ENo_Data_Allowed_Err = class(EdomException); ENo_Modification_Allowed_Err = class(EdomException); ENot_Found_Err = class(EdomException); ENot_Supported_Err = class(EdomException); EInuse_Attribute_Err = class(EdomException); EInvalid_State_Err = class(EdomException); ESyntax_Err = class(EdomException); EInvalid_Modification_Err = class(EdomException); ENamespace_Err = class(EdomException); EInvalid_Access_Err = class(EdomException); EInuse_Node_Err = class(EdomException); EInuse_Content_Model_Err = class(EdomException); EInuse_AttributeDefinition_Err = class(EdomException); ENo_External_Entity_Allowed_Err = class(EdomException); EUnknown_Document_Format_Err = class(EdomException); EDomASException = class(EdomException); EDuplicate_Name_Err = class(EDomASException); ENo_AS_Available = class(EDomASException); EType_Err = class(EDomASException); EValidation_Err = class(EDomASException); EWrong_MIME_Type_Err = class(EDomASException); EWrong_ASModel_Err = class(EDomASException); // xxx Replace this! EParserException = class(EdomException); EXPath_Exception = class(EdomException); EXPath_Invalid_Expression_Err = class(EXPath_Exception); EXPath_Type_Err = class(EXPath_Exception); TXmlErrorType = ( // Remark: The order and number of this error types is perhaps going to // change in future XDOM versions. So, if possible, do refer to // error types by using the constants below, but avoid using // their numerical equivalents! ET_NONE, // No Error ET_DOUBLE_ATTDEF, ET_DOUBLE_ENTITY_DECL, ET_DOUBLE_PARAMETER_ENTITY_DECL, ET_UNUSABLE_ENTITY_DECL, ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH, ET_ATTRIBUTE_DEFINITION_NOT_FOUND, ET_ATTRIBUTE_TYPE_MISMATCH, ET_DUPLICATE_ELEMENT_TYPE_DECL, ET_DUPLICATE_ENUMERATION_TOKEN, ET_DUPLICATE_ID_ON_ELEMENT_TYPE, ET_DUPLICATE_ID_VALUE, ET_DUPLICATE_NAME_IN_MIXED_CONTENT, ET_DUPLICATE_NOTATION_DECL, ET_DUPLICATE_NOTATION_ON_ELEMENT_TYPE, ET_DUPLICATE_NOTATION_TOKEN, ET_DUPLICATE_TOKENS, ET_FIXED_ATTRIBUTE_MISMATCH, ET_ID_NEITHER_IMPLIED_NOR_REQUIRED, ET_ELEMENT_DECLARED_EMPTY_HAS_CONTENT, ET_ELEMENT_TYPE_DECL_NOT_FOUND, ET_ELEMENT_WITH_ILLEGAL_ELEMENT_CONTENT, ET_ELEMENT_WITH_ILLEGAL_MIXED_CONTENT, ET_ENTITY_DECL_NOT_FOUND, ET_EXTERNAL_SUBSET_NOT_FOUND, ET_NONDETERMINISTIC_ELEMENT_CONTENT_MODEL, ET_NOTATION_ON_EMPTY_ELEMENT, ET_PARAMETER_ENTITY_DECL_NOT_FOUND, ET_REQUIRED_ATTRIBUTE_NOT_FOUND, ET_TARGET_ID_VALUE_NOT_FOUND, ET_TARGET_UNPARSED_ENTITY_NOT_FOUND, ET_UNDECLARED_NOTATION_NAME, ET_UNRESOLVABLE_ENTITY_REFERENCE, ET_UNRESOLVABLE_PARAMETER_ENTITY_REFERENCE, ET_WRONG_DECL_OF_PREDEFINED_ENTITY, ET_WRONG_ROOT_ELEMENT_TYPE, ET_ATTRIBUTE_VALUE_REFERS_TO_EXTERNAL_ENTITY, ET_DOUBLE_ATTRIBUTE_NAME, ET_DOUBLE_EQUALITY_SIGN, ET_DOUBLE_ROOT_ELEMENT, ET_INVALID_ATTRIBUTE_NAME, ET_INVALID_ATTRIBUTE_VALUE, ET_INVALID_CDATA_SECTION, ET_INVALID_CHARACTER, ET_INVALID_CHARREF, ET_INVALID_COMMENT, ET_INVALID_ELEMENT_NAME, ET_INVALID_ENTITY_NAME, ET_INVALID_PROCESSING_INSTRUCTION, ET_INVALID_PUBID_LITERAL, ET_INVALID_SYSTEM_LITERAL, ET_INVALID_TEXT_DECL, ET_INVALID_XML_DECL, ET_LT_IN_ATTRIBUTE_VALUE, ET_MISSING_END_TAG, ET_MISSING_EQUALITY_SIGN, ET_MISSING_QUOTATION_MARK, ET_MISSING_START_TAG, ET_MISSING_WHITE_SPACE, ET_NOT_IN_ROOT, ET_NO_PROPER_MARKUP_REFERENCED, ET_RECURSIVE_REFERENCE, ET_REFERENCE_TO_UNPARSED_ENTITY, ET_WRONG_ORDER, ET_DOUBLE_DOCTYPE, ET_INVALID_ATTRIBUTE_DECL, ET_INVALID_CONDITIONAL_SECTION, ET_INVALID_DOCTYPE, ET_INVALID_ELEMENT_DECL, ET_INVALID_ENTITY_DECL, ET_INVALID_NOTATION_DECL, ET_UNKNOWN_DECL_TYPE, ET_INVALID_NAMESPACE_URI, ET_INVALID_PREFIX, ET_INVALID_QUALIFIED_NAME, ET_NAMESPACE_URI_NOT_FOUND, ET_WRONG_PREFIX_MAPPING_NESTING, ET_ENCODING_NOT_SUPPORTED ); TXmlErrorTypes = set of TXmlErrorType; const ET_WARNINGS: TXmlErrorTypes = [ ET_NONE, // Included in ET_WARNINGS to ease calculations. ET_DOUBLE_ATTDEF, ET_DOUBLE_ENTITY_DECL, ET_DOUBLE_PARAMETER_ENTITY_DECL, ET_UNUSABLE_ENTITY_DECL ]; ET_ERRORS: TXmlErrorTypes = [ ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH, ET_ATTRIBUTE_DEFINITION_NOT_FOUND, ET_ATTRIBUTE_TYPE_MISMATCH, ET_DUPLICATE_ELEMENT_TYPE_DECL, ET_DUPLICATE_ENUMERATION_TOKEN, ET_DUPLICATE_ID_ON_ELEMENT_TYPE, ET_DUPLICATE_ID_VALUE, ET_DUPLICATE_NAME_IN_MIXED_CONTENT, ET_DUPLICATE_NOTATION_DECL, ET_DUPLICATE_NOTATION_ON_ELEMENT_TYPE, ET_DUPLICATE_NOTATION_TOKEN, ET_DUPLICATE_TOKENS, ET_ELEMENT_DECLARED_EMPTY_HAS_CONTENT, ET_ELEMENT_TYPE_DECL_NOT_FOUND, ET_ELEMENT_WITH_ILLEGAL_ELEMENT_CONTENT, ET_ELEMENT_WITH_ILLEGAL_MIXED_CONTENT, ET_ENTITY_DECL_NOT_FOUND, ET_EXTERNAL_SUBSET_NOT_FOUND, ET_FIXED_ATTRIBUTE_MISMATCH, ET_ID_NEITHER_IMPLIED_NOR_REQUIRED, ET_NONDETERMINISTIC_ELEMENT_CONTENT_MODEL, ET_NOTATION_ON_EMPTY_ELEMENT, ET_PARAMETER_ENTITY_DECL_NOT_FOUND, ET_REQUIRED_ATTRIBUTE_NOT_FOUND, ET_TARGET_ID_VALUE_NOT_FOUND, ET_TARGET_UNPARSED_ENTITY_NOT_FOUND, ET_UNDECLARED_NOTATION_NAME, ET_UNRESOLVABLE_ENTITY_REFERENCE, ET_UNRESOLVABLE_PARAMETER_ENTITY_REFERENCE, ET_WRONG_DECL_OF_PREDEFINED_ENTITY, ET_WRONG_ROOT_ELEMENT_TYPE ]; ET_FATAL_ERRORS: TXmlErrorTypes = [ ET_ATTRIBUTE_VALUE_REFERS_TO_EXTERNAL_ENTITY, ET_DOUBLE_ATTRIBUTE_NAME, ET_DOUBLE_EQUALITY_SIGN, ET_DOUBLE_ROOT_ELEMENT, ET_INVALID_ATTRIBUTE_NAME, ET_INVALID_ATTRIBUTE_VALUE, ET_INVALID_CDATA_SECTION, ET_INVALID_CHARACTER, ET_INVALID_CHARREF, ET_INVALID_COMMENT, ET_INVALID_ELEMENT_NAME, ET_INVALID_ENTITY_NAME, ET_INVALID_PROCESSING_INSTRUCTION, ET_INVALID_PUBID_LITERAL, ET_INVALID_SYSTEM_LITERAL, ET_INVALID_TEXT_DECL, ET_INVALID_XML_DECL, ET_LT_IN_ATTRIBUTE_VALUE, ET_MISSING_END_TAG, ET_MISSING_EQUALITY_SIGN, ET_MISSING_QUOTATION_MARK, ET_MISSING_START_TAG, ET_MISSING_WHITE_SPACE, ET_NOT_IN_ROOT, ET_NO_PROPER_MARKUP_REFERENCED, ET_RECURSIVE_REFERENCE, ET_REFERENCE_TO_UNPARSED_ENTITY, ET_WRONG_ORDER, ET_DOUBLE_DOCTYPE, ET_INVALID_ATTRIBUTE_DECL, ET_INVALID_CONDITIONAL_SECTION, ET_INVALID_DOCTYPE, ET_INVALID_ELEMENT_DECL, ET_INVALID_ENTITY_DECL, ET_INVALID_NOTATION_DECL, ET_UNKNOWN_DECL_TYPE, ET_INVALID_NAMESPACE_URI, ET_INVALID_PREFIX, ET_INVALID_QUALIFIED_NAME, ET_NAMESPACE_URI_NOT_FOUND, ET_WRONG_PREFIX_MAPPING_NESTING, ET_ENCODING_NOT_SUPPORTED ]; ET_DOCTYPE_FATAL_ERRORS: TXmlErrorTypes = [ ET_INVALID_DOCTYPE, ET_DOUBLE_DOCTYPE, ET_INVALID_ATTRIBUTE_DECL, ET_INVALID_CONDITIONAL_SECTION, ET_INVALID_ELEMENT_DECL, ET_INVALID_ENTITY_DECL, ET_INVALID_NOTATION_DECL, ET_UNKNOWN_DECL_TYPE ]; ET_NAMESPACE_FATAL_ERRORS: TXmlErrorTypes = [ ET_INVALID_NAMESPACE_URI, ET_INVALID_PREFIX, ET_INVALID_QUALIFIED_NAME, ET_NAMESPACE_URI_NOT_FOUND, ET_WRONG_PREFIX_MAPPING_NESTING ]; type TIso639LanguageCode = ( iso639_aa, // Afar iso639_ab, // Abkhazian iso639_af, // Afrikaans iso639_am, // Amharic iso639_ar, // Arabic iso639_as, // Assamese iso639_ay, // Aymara iso639_az, // Azerbaijani iso639_ba, // Bashkir iso639_be, // Byelorussian iso639_bg, // Bulgarian iso639_bh, // Bihari iso639_bi, // Bislama iso639_bn, // Bengali; Bangla iso639_bo, // Tibetan iso639_br, // Breton iso639_ca, // Catalan iso639_co, // Corsican iso639_cs, // Czech iso639_cy, // Welsh iso639_da, // Danish iso639_de, // German iso639_dz, // Bhutani iso639_el, // Greek iso639_en, // English iso639_eo, // Esperanto iso639_es, // Spanish iso639_et, // Estonian iso639_eu, // Basque iso639_fa, // Persian iso639_fi, // Finnish iso639_fj, // Fiji iso639_fo, // Faeroese iso639_fr, // French iso639_fy, // Frisian iso639_ga, // Irish iso639_gd, // Scots Gaelic iso639_gl, // Galician iso639_gn, // Guarani iso639_gu, // Gujarati iso639_ha, // Hausa iso639_hi, // Hindi iso639_hr, // Croatian iso639_hu, // Hungarian iso639_hy, // Armenian iso639_ia, // Interlingua iso639_ie, // Interlingue iso639_ik, // Inupiak iso639_in, // Indonesian iso639_is, // Icelandic iso639_it, // Italian iso639_iw, // Hebrew iso639_ja, // Japanese iso639_ji, // Yiddish iso639_jw, // Javanese iso639_ka, // Georgian iso639_kk, // Kazakh iso639_kl, // Greenlandic iso639_km, // Cambodian iso639_kn, // Kannada iso639_ko, // Korean iso639_ks, // Kashmiri iso639_ku, // Kurdish iso639_ky, // Kirghiz iso639_la, // Latin iso639_ln, // Lingala iso639_lo, // Laothian iso639_lt, // Lithuanian iso639_lv, // Latvian; Lettish iso639_mg, // Malagasy iso639_mi, // Maori iso639_mk, // Macedonian iso639_ml, // Malayalam iso639_mn, // Mongolian iso639_mo, // Moldavian iso639_mr, // Marathi iso639_ms, // Malay iso639_mt, // Maltese iso639_my, // Burmese iso639_na, // Nauru iso639_ne, // Nepali iso639_nl, // Dutch iso639_no, // Norwegian iso639_oc, // Occitan iso639_om, // Afan; Oromo iso639_or, // Oriya iso639_pa, // Punjabi iso639_pl, // Polish iso639_ps, // Pashto; Pushto iso639_pt, // Portuguese iso639_qu, // Quechua iso639_rm, // Rhaeto-Romance iso639_rn, // Kirundi iso639_ro, // Romanian iso639_ru, // Russian iso639_rw, // Kinyarwanda iso639_sa, // Sanskrit iso639_sd, // Sindhi iso639_sg, // Sangro iso639_sh, // Serbo-Croatian iso639_si, // Singhalese iso639_sk, // Slovak iso639_sl, // Slovenian iso639_sm, // Samoan iso639_sn, // Shona iso639_so, // Somali iso639_sq, // Albanian iso639_sr, // Serbian iso639_ss, // Siswati iso639_st, // Sesotho iso639_su, // Sundanese iso639_sv, // Swedish iso639_sw, // Swahili iso639_ta, // Tamil iso639_te, // Tegulu iso639_tg, // Tajik iso639_th, // Thai iso639_ti, // Tigrinya iso639_tk, // Turkmen iso639_tl, // Tagalog iso639_tn, // Setswana iso639_to, // Tonga iso639_tr, // Turkish iso639_ts, // Tsonga iso639_tt, // Tatar iso639_tw, // Twi iso639_uk, // Ukrainian iso639_ur, // Urdu iso639_uz, // Uzbek iso639_vi, // Vietnamese iso639_vo, // Volapuk iso639_wo, // Wolof iso639_xh, // Xhosa iso639_yo, // Yoruba iso639_zh, // Chinese iso639_zu // Zulu ); TIso639LanguageCodeSet = set of TIso639LanguageCode; TdomNodeType = (ntUnknown, ntElement_Node, ntAttribute_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node, ntEntity_Node, ntProcessing_Instruction_Node, ntComment_Node, ntDocument_Node, ntDocument_Type_Node, ntDocument_Fragment_Node, ntNotation_Node, ntXPath_Namespace_Node); TdomWhatToShow = set of TdomNodeType; const SHOW_ALL: TdomWhatToShow = [ntElement_Node .. High(TDomNodeType)]; AS_UNBOUND = High(integer); type TdomXPathResultType = ( XPATH_BOOLEAN_TYPE, XPATH_NODE_SNAPSHOT_TYPE, XPATH_NUMBER_TYPE, XPATH_STRING_TYPE ); TdomXPathResultTypes = set of TdomXPathResultType; const XPATH_ANY_TYPE: TdomXPathResultTypes = [XPATH_BOOLEAN_TYPE .. High(TdomXPathResultType)]; type TdomNodeTypeSet = set of TdomNodeType; TdomPieceType = (xmlProcessingInstruction,xmlXmlDeclaration, // xxx xmlXmlDeclaration necessary? xmlTextDeclaration,xmlComment,xmlCDATA,xmlPCDATA, // xxx xmlTextDeclaration necessary? xmlDoctype,xmlStartTag,xmlEndTag,xmlEmptyElementTag, xmlCharRef,xmlEntityRef,xmlParameterEntityRef, xmlEntityDecl,xmlElementDecl,xmlAttributeDecl, xmlNotationDecl,xmlCondSection,xmlUnknown); TdomTreePosition = set of ( Tree_Position_Ancestor, Tree_Position_Descendant, Tree_Position_Disconnected, Tree_Position_Equivalent, Tree_Position_Following, Tree_Position_Preceding, Tree_Position_Same_Node ); TdomEntityResolveOption = (erReplace,erExpand); TdomContentspecType = (ctEmpty,ctAny,ctMixed,ctChildren); TdomEntityType = (etExternal_Entity,etInternal_Entity); TdomFilterResult = (filter_accept,filter_reject,filter_skip); TdomFilenameToUriOptions = set of (fuSetLocalhost,fuPlainColon); TdomNode = class; TdomAttr = class; TdomElement = class; TdomDocument = class; TdomDocumentType = class; TdomEntity = class; TdomNotation = class; TdomNodeList = class; TdomAbstractView = class; TdomMediaList = class; TXmlSourceCodePiece = class; TdomDocumentClass = class of TdomDocument; PdomDocumentFormat = ^TdomDocumentFormat; TdomDocumentFormat = record DocumentClass: TdomDocumentClass; NamespaceUri: wideString; QualifiedName: wideString; next: PdomDocumentFormat; end; TdomWideStringItem = record FString: WideString; FObject: TObject; end; PdomWideStringItemList = ^TdomWideStringItemList; TdomWideStringItemList = array[0..MaxListSize] of TdomWideStringItem; TdomWideStringList = class(TPersistent) private FCapacity: integer; FCount: integer; FDuplicates: TDuplicates; FList: PdomWideStringItemList; FSorted: boolean; FUpdateCount: integer; FOnChange: TNotifyEvent; FOnChanging: TNotifyEvent; procedure exchangeItems(index1, index2: integer); procedure grow; procedure insertItem(index: integer; const s: wideString; AObject: TObject); procedure quickSort(l, r: integer); procedure setSorted(const value: boolean); protected procedure changed; virtual; procedure changing; virtual; procedure error(const msg: string; data: integer); function get(index: integer): WideString; virtual; function getCapacity: integer; virtual; function getCount: integer; virtual; function getObject(index: integer): TObject; virtual; procedure put(index: integer; const s: wideString); virtual; procedure putObject(index: integer; aObject: TObject); virtual; procedure setCapacity(newCapacity: integer); virtual; procedure setUpdateState(updating: boolean); virtual; public destructor destroy; override; function add(s: wideString): integer; virtual; function addObject(s: wideString; AObject: TObject): integer; virtual; procedure addWideStrings(strings: TdomWideStringList); virtual; procedure append(s: wideString); virtual; procedure assign(source: TPersistent); override; procedure beginUpdate; virtual; procedure clear; virtual; procedure Delete(index: integer); virtual; procedure endUpdate; virtual; procedure exchange(index1, index2: integer); virtual; function find(const s: wideString; var index: integer): boolean; virtual; function indexOf(const s: wideString): integer; virtual; procedure insert(index: integer; const s: wideString); virtual; procedure insertObject(index: integer; const s: wideString; AObject: TObject); virtual; procedure sort; virtual; property capacity: integer read getCapacity write setCapacity; property count: integer read getCount; property duplicates: TDuplicates read FDuplicates write FDuplicates; property objects[index: integer]: TObject read getObject write putObject; property sorted: boolean read FSorted write setSorted; property wideStrings[index: integer]: wideString read get write put; default; property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnChanging: TNotifyEvent read FOnChanging write FOnChanging; end; TdomNameValueList = class(TPersistent) private FNames: TdomWideStringList; FValues: TdomWideStringList; procedure error(const msg: string; data: integer); function getLength: integer; virtual; function getCapacity: integer; virtual; function getDuplicates: TDuplicates; function getName(index: integer): wideString; virtual; function getObject(index: integer): TObject; virtual; function getValue(index: integer): wideString; virtual; procedure putObject(index: integer; aObject: TObject); virtual; procedure setCapacity(const value: integer); virtual; procedure setDuplicates(const value: TDuplicates); procedure setSorted(const Value: boolean); function getSorted: boolean; public constructor create; destructor destroy; override; function add(const name, value: wideString): integer; virtual; function addObject(const name, value: wideString; AObject: TObject): integer; virtual; procedure addNameValueList(const nvl: TdomNameValueList); virtual; procedure assign(source: TPersistent); override; procedure clear; virtual; procedure Delete(const index: integer); virtual; procedure exchange(const index1, index2: integer); virtual; function indexOf(const name, value: wideString): integer; virtual; function indexOfName(const name: wideString): integer; virtual; procedure insert(const index: integer; const name, value: wideString); virtual; function find(const name, value: wideString; var index: integer): boolean; virtual; function findOfName(const name: wideString; var index: integer): boolean; virtual; procedure sort; virtual; property capacity: integer read getCapacity write setCapacity; property duplicates: TDuplicates read getDuplicates write setDuplicates; property length: integer read getLength; property names[index: integer]: wideString read getName; property objects[index: integer]: TObject read getObject write putObject; property sorted: boolean read getSorted write setSorted; property values[index: integer]: wideString read getValue; end; TdomNameValueTree = class(TdomNameValueList) private FParentTree: TdomNameValueTree; function getChild(index: integer): TdomNameValueTree; public destructor Destroy; override; function addChild(const name, value: wideString; const child: TdomNameValueTree): integer; virtual; function addChildObject(const name, value: wideString; const child: TdomNameValueTree; const AObject: TObject): integer; virtual; procedure assign(source: TPersistent); override; procedure clear; override; procedure Delete(const index: integer); override; function hasChild(const index: integer): boolean; virtual; function indexOfChild(const child: TdomNameValueTree): integer; virtual; procedure insertChild(const index: integer; const name, value: wideString; const child: TdomNameValueTree); virtual; function isDescendantOf(const nvtree: TdomNameValueTree): boolean; virtual; function replaceChild(const index: integer; const newChild: TdomNameValueTree): TdomNameValueTree; virtual; property children[index: integer]: TdomNameValueTree read getChild; property parentTree: TdomNameValueTree read FParentTree; end; TdomCustomStr = class private FActualLen: integer; FCapacity: integer; FContent: wideString; protected function getWideChars(indx: integer): wideChar; virtual; procedure setWideChars(indx: integer; ch: wideChar); virtual; public constructor create; procedure addWideChar(const ch: wideChar); virtual; procedure addWideString(const s: wideString); virtual; function endsWith(const s: wideString): boolean; virtual; function isEqual(const s: wideString): boolean; virtual; procedure reset; virtual; // xxx rename this into 'clear'? function startsWith(const s: wideString): boolean; virtual; function value: wideString; virtual; // Since calling the value function involves time // consuming string copying, always use one of the // other TdomCustomStr access functions, if possible, // e.g. wideChars[index] instead of value[index], // isEqual[s] instead of (value = s), or // length instead of length(value). property length: integer read FActualLen; property wideChars[indx: integer]: wideChar read getWideChars write setWideChars; default; end; TdomWideStringStream = class(TStream) private FDataStringP: PChar; FSize: longint; FCapacity: longint; FPosition: longint; protected procedure setCapacity(newCapacity: longint); virtual; procedure setSize(newSize: longint); override; procedure setStringPosition(value: longint); function getStringPosition: longint; procedure setStringLength(value: longint); function getStringLength: longint; function getDataString: wideString; public constructor createFromString(const aString: wideString); destructor destroy; override; function read(var buffer; count: longint): longint; override; function readString(count: longint): wideString; function seek(offset: longint; origin: word): longint; override; function write(const buffer; count: longint): longint; override; procedure writeString(const aString: wideString); property capacity: longint read FCapacity write setCapacity; property stringLength: longint read getStringLength write setStringLength; property stringPosition: longint read getStringPosition write setStringPosition; property dataString: wideString read getDataString; end; TIso639Info = class(TPersistent) private function codeToName_en(value: TIso639LanguageCode): wideString; function nameToCode_en(value: wideString): TIso639LanguageCode; protected FAppendSymbolToName: boolean; FNameLanguage: TIso639LanguageCode; FSupportedLanguages: TIso639LanguageCodeSet; procedure assignTo(dest: TPersistent); override; procedure setNameLanguage(const value: TIso639LanguageCode); virtual; public constructor create; function codeToName(const value: TIso639LanguageCode): wideString; virtual; function codeToSymbol(const value: TIso639LanguageCode): wideString; virtual; function nameToCode(const value: wideString): TIso639LanguageCode; virtual; function symbolToCode(const value: wideString): TIso639LanguageCode; virtual; property appendSymbolToName: boolean read FAppendSymbolToName write FAppendSymbolToName default false; property nameLanguage: TIso639LanguageCode read FNameLanguage write setNameLanguage default iso639_en; property supportedLanguages: TIso639LanguageCodeSet read FSupportedLanguages; end; TdomCMNodeList = class; TdomCMObject = class; TdomCMEntity = class; TdomCMExternalObject = class; TdomCMInternalObject = class; TdomError = class; TdomXPathExpression = class; TdomXPathNSResolver = class; TdomXPathResult = class; TdomXPathSnapshotResult = class; TXmlParserAction = (paFail,paRetry,paOK); TdomNewLineType = (nltCRLF,ntlCR,ntlLF); TdomAttrChange = ( AC_ADDITION, AC_MODIFICATION, AC_REMOVAL); TdomAttrModifiedDocEvent = procedure(sender: TObject; modifiedDoc: TdomDocument; modifiedNode: TdomNode; attrChange: TdomAttrChange; prevValue, newValue: wideString; relatedAttr: TdomAttr) of object; TdomAttrModifiedEvent = procedure(sender: TObject; modifiedNode: TdomNode; attrChange: TdomAttrChange; prevValue, newValue: wideString; relatedAttr: TdomAttr) of object; TdomCharacterDataModifiedDocEvent = procedure(sender: TObject; modifiedDoc: TdomDocument; modifiedNode: TdomNode; prevValue, newValue: wideString) of object; TdomCharacterDataModifiedEvent = procedure(sender: TObject; modifiedNode: TdomNode; prevValue, newValue: wideString) of object; TdomNodeModifiedDocEvent = procedure(sender: TObject; modifiedDoc: TdomDocument; modifiedNode: TdomNode) of object; TdomNodeModifiedEvent = procedure(sender: TObject; modifiedNode: TdomNode) of object; TXmlParserEvent = procedure( sender: TObject; const parentSystemId: wideString; var publicId, systemId: wideString; var stream: TStream; var action: TXmlParserAction) of object; TdomErrorEvent = procedure( sender: TObject; error: TdomError; var go: boolean) of object; TDomImplementation = class (TComponent) private FOnError: TdomErrorEvent; FOnExternalParsedEntity: TXmlParserEvent; FOnAttrModified: TdomAttrModifiedDocEvent; FOnCharacterDataModified: TdomCharacterDataModifiedDocEvent; FOnNodeRemoved: TdomNodeModifiedDocEvent; FOnNodeInserted: TdomNodeModifiedDocEvent; protected FCreatedCMExternalObjects: TdomCMNodeList; FCreatedCMInternalObjects: TdomCMNodeList; FCreatedCMObjects: TdomCMNodeList; FCreatedDocuments: TdomNodeList; FCreatedDocumentTypes: TdomNodeList; FCreatedCMExternalObjectsListing: TList; FCreatedCMInternalObjectsListing: TList; FCreatedCMObjectsListing: TList; FCreatedDocumentsListing: TList; FCreatedDocumentTypesListing: TList; procedure doAttrModified(modifiedDoc: TdomDocument; modifiedNode: TdomNode; attrChange: TdomAttrChange; prevValue, newValue: wideString; relatedAttr: TdomAttr); virtual; procedure doCharacterDataModified(modifiedDoc: TdomDocument; modifiedNode: TdomNode; prevValue, newValue: wideString); virtual; procedure doError( sender: TObject; error: TdomError; var go: boolean); virtual; procedure doExternalParsedEntity( parentSystemId: wideString; var publicId, systemId: wideString; var stream: TStream; var action: TXmlParserAction); virtual; procedure doNodeInserted(modifiedDoc: TdomDocument; modifiedNode: TdomNode); virtual; procedure doNodeRemoved(modifiedDoc: TdomDocument; modifiedNode: TdomNode); virtual; function getCMExternalObjects: TdomCMNodeList; virtual; function getCMInternalObjects: TdomCMNodeList; virtual; function getCMObjects: TdomCMNodeList; virtual; function getDocuments: TdomNodeList; virtual; function getDocumentTypes: TdomNodeList; virtual; function getXdomVersion: wideString; virtual; public constructor create(aOwner: TComponent); override; destructor destroy; override; procedure clear; virtual; function createCMExternalObject(const pubId, sysId: wideString): TdomCMExternalObject; virtual; function createCMInternalObject(const pubId, sysId: wideString): TdomCMInternalObject; virtual; function createCMObject(const sysId: wideString): TdomCMObject; virtual; function createDocument(const aname: wideString; doctype: TdomDocumentType): TdomDocument; virtual; function createDocumentNS(const namespaceURI, qualifiedName: wideString; doctype: TdomDocumentType): TdomDocument; virtual; { The following two methods have been removed from this version of the XDOM, but will be reintroduced in a future release. function createDocumentType(const name, publicId, systemId, intSubset: wideString): TdomDocumentType; virtual; function createDocumentTypeNS(const qualifiedName, publicId, systemId, intSubset: wideString): TdomDocumentType; virtual; } procedure freeCMExternalObject(var arg: TdomCMExternalObject); virtual; procedure freeCMInternalObject(var arg: TdomCMInternalObject); virtual; procedure freeCMObject(var arg: TdomCMObject); virtual; procedure freeDocument(var doc: TdomDocument); virtual; procedure freeDocumentType(var docType: TdomDocumentType); virtual; function hasFeature(const feature, version: wideString): boolean; virtual; function getDocumentClass(const aNamespaceUri, aQualifiedName: wideString): TdomDocumentClass; virtual; function handleError(const sender: TObject; const error: TdomError): boolean; virtual; class procedure registerDocumentFormat(const aNamespaceUri, aQualifiedName: wideString; aDocumentClass: TdomDocumentClass); virtual; function supportsDocumentFormat(const aNamespaceUri, aQualifiedName: wideString): boolean; virtual; class procedure unregisterDocumentClass(const aDocumentClass: TdomDocumentClass); virtual; property cmExternalObjects: TdomCMNodeList read getCMExternalObjects; property cmInternalObjects: TdomCMNodeList read getCMInternalObjects; property cmObjects: TdomCMNodeList read getCMObjects; property documents: TdomNodeList read getDocuments; property documentTypes: TdomNodeList read getDocumentTypes; property xdomVersion: wideString read getXdomVersion; published property OnAttrModified: TdomAttrModifiedDocEvent read FOnAttrModified write FOnAttrModified; property OnCharacterDataModified: TdomCharacterDataModifiedDocEvent read FOnCharacterDataModified write FOnCharacterDataModified; property OnError: TdomErrorEvent read FOnError write FOnError; property OnExternalParsedEntity: TXmlParserEvent read FOnExternalParsedEntity write FOnExternalParsedEntity; property OnNodeInserted: TdomNodeModifiedDocEvent read FOnNodeInserted write FOnNodeInserted; property OnNodeRemoved: TdomNodeModifiedDocEvent read FOnNodeRemoved write FOnNodeRemoved; end; TdomNodeFilter = class public function acceptNode(const n: TdomNode): TdomFilterResult; virtual; abstract; end; TdomTreeWalker = class private FCurrentNode: TdomNode; FExpandEntityReferences: boolean; FFilter: TdomNodeFilter; FRoot: TdomNode; FWhatToShow: TdomWhatToShow; protected function findFirstChild(const oldNode: TdomNode): TdomNode; virtual; function findLastChild(const oldNode: TdomNode): TdomNode; virtual; function findNextNode(oldNode: TdomNode): TdomNode; virtual; function findNextSibling(const oldNode: TdomNode): TdomNode; virtual; function findParentNode(const oldNode: TdomNode): TdomNode; virtual; function findPreviousNode(const oldNode: TdomNode): TdomNode; virtual; function findPreviousSibling(const oldNode: TdomNode): TdomNode; virtual; procedure setCurrentNode(const node: TdomNode); virtual; procedure setExpandEntityReferences(const value: boolean); virtual; // Derived classes can move this method to the public section to allow write access. procedure setFilter(const value: TdomNodeFilter); virtual; // Derived classes can move this method to the public section to allow write access. procedure setRoot(const node: TdomNode); virtual; // Derived classes can move this method to the public section to allow write access. procedure setWhatToShow(const value: TdomWhatToShow); virtual; // Derived classes can move this method to the public section to allow write access. public constructor create(const root: TdomNode; const whatToShow: TdomWhatToShow; const nodeFilter: TdomNodeFilter; const entityReferenceExpansion: boolean); virtual; function parentNode: TdomNode; virtual; function firstChild: TdomNode; virtual; function lastChild: TdomNode; virtual; function previousSibling: TdomNode; virtual; function nextSibling: TdomNode; virtual; function nextNode: TdomNode; virtual; function previousNode: TdomNode; virtual; property currentNode: TdomNode read FCurrentNode write setCurrentNode; property expandEntityReferences: boolean read FExpandEntityReferences; property filter: TdomNodeFilter read FFilter; property root: TdomNode read FRoot; property whatToShow: TdomWhatToShow read FWhatToShow; end; TdomPosition = (posBefore,posAfter); TdomNodeIterator = class private FRoot: TdomNode; FReferenceNode: TdomNode; FPosition: TdomPosition; // Position of the Iterator relativ to FReferenceNode FWhatToShow: TdomWhatToShow; FExpandEntityReferences: boolean; FFilter: TdomNodeFilter; FInvalid: boolean; protected procedure findNewReferenceNode(const nodeToRemove: TdomNode); virtual; // To be called if the current FReferenceNode is being removed function findNextNode(oldNode: TdomNode): TdomNode; virtual; function findPreviousNode(const oldNode: TdomNode): TdomNode; virtual; public constructor create(const root: TdomNode; const whatToShow: TdomWhatToShow; const nodeFilter: TdomNodeFilter; const entityReferenceExpansion: boolean); virtual; procedure detach; virtual; function nextNode: TdomNode; virtual; function previousNode: TdomNode; virtual; property expandEntityReferences: boolean read FExpandEntityReferences; property filter: TdomNodeFilter read FFilter; property root: TdomNode read FRoot; property whatToShow: TdomWhatToShow read FWhatToShow; end; TdomNodeList = class private FNodeList: TList; protected function getLength: integer; virtual; function indexOf(const node: TdomNode): integer; virtual; public constructor create(const nodeList: TList); function item(const index: integer): TdomNode; virtual; property length: integer read getLength; end; TdomElementsNodeList = class(TdomNodeList) private FQueryName: wideString; FStartElement: TdomNode; protected function getLength: integer; override; public function indexOf(const node: TdomNode): integer; override; function item(const index: integer): TdomNode; override; constructor create(const queryName: wideString; const startElement: TdomNode); virtual; end; TdomElementsNodeListNS = class(TdomNodeList) private FQueryNamespaceURI: wideString; FQueryLocalName: wideString; FStartElement: TdomNode; protected function getLength: integer; override; public function indexOf(const node: TdomNode): integer; override; function item(const index: integer): TdomNode; override; constructor create(const queryNamespaceURI, queryLocalName: wideString; const startElement: TdomNode); virtual; end; TdomSpecialNodeList = class(TdomNodeList) protected FAllowedNodeTypes: TDomNodeTypeSet; function getLength: integer; override; function getNamedIndex(const name: wideString): integer; virtual; function getNamedItem(const name: wideString): TdomNode; virtual; public constructor create(const nodeList: TList; const allowedNTs: TDomNodeTypeSet); virtual; function indexOf(const node: TdomNode): integer; override; function item(const index: integer): TdomNode; override; end; TdomNamedNodeMap = class(TdomNodeList) private FIsReadonly: boolean; FNamespaceAware: boolean; FOwner: TdomNode; // The owner document. FOwnerNode: TdomNode; // The node to which the map is attached to. function getNamespaceAware: boolean; virtual; function getOwnerNode: TdomNode; virtual; procedure setNamespaceAware(const value: boolean); virtual; protected FAllowedNodeTypes: TDomNodeTypeSet; function getNamedIndex(const name: wideString): integer; virtual; function removeItem(const arg: TdomNode): TdomNode; virtual; procedure setIsReadonly(const value: boolean); virtual; public constructor create(const aOwner, aOwnerNode: TdomNode; const nodeList: TList; const allowedNTs: TDomNodeTypeSet); virtual; function getNamedItem(const name: wideString): TdomNode; virtual; function getNamedItemNS(const namespaceURI, localName: wideString): TdomNode; virtual; function removeNamedItem(const name: wideString): TdomNode; virtual; function removeNamedItemNS(const namespaceURI, localName: wideString): TdomNode; virtual; function setNamedItem(const arg: TdomNode): TdomNode; virtual; function setNamedItemNS(const arg: TdomNode): TdomNode; virtual; property isReadonly: boolean read FIsReadonly; property namespaceAware: boolean read getNamespaceAware write setNamespaceAware default false; property ownerNode: TdomNode read getOwnerNode; end; TdomLocator = class; TdomNode = class private FNodeName: wideString; FNodeValue: wideString; FNodeType: TdomNodeType; FNodeList: TdomNodeList; FNodeListing: TList; FDocument: TdomDocument; FParentNode: TdomNode; FIsNamespaceNode: boolean; FIsReadonly: boolean; FOnAttrModified: TdomAttrModifiedEvent; FOnCharacterDataModified: TdomCharacterDataModifiedEvent; FOnNodeInserted: TdomNodeModifiedEvent; FOnNodeInsertedIntoDocument: TdomNodeModifiedEvent; FOnNodeRemoved: TdomNodeModifiedEvent; FOnNodeRemovedFromDocument: TdomNodeModifiedEvent; procedure makeChildrenReadonly; virtual; function refersToExternalEntity: boolean; virtual; function hasEntRef(const entName: widestring): boolean; virtual; protected FAllowedChildTypes: set of TDomNodeType; FLocalName: wideString; FNamespaceURI: wideString; FPrefix: wideString; procedure doAttrModified(originalTarget: TdomNode; attrChange: TdomAttrChange; prevValue, newValue: wideString; relatedAttr: TdomAttr); virtual; procedure doCharacterDataModified(originalTarget: TdomNode; prevValue, newValue: wideString); virtual; procedure doNodeInserted(originalTarget: TdomNode); virtual; procedure doNodeInsertedIntoDocument(originalTarget: TdomNode); virtual; procedure doNodeRemoved(originalTarget: TdomNode); virtual; procedure doNodeRemovedFromDocument(originalTarget: TdomNode); virtual; function getAttributes: TdomNamedNodeMap; virtual; function getBaseUri: wideString; virtual; function getChildNodes: TdomNodeList; virtual; function getDocument: TdomDocument; virtual; function getFirstChild: TdomNode; virtual; function getNextSibling: TdomNode; virtual; function getNodeName: wideString; virtual; function getNodeValue: wideString; virtual; function getNodeType: TdomNodeType; virtual; function getLastChild: TdomNode; virtual; function getParentNode: TdomNode; virtual; function getPreviousSibling: TdomNode; virtual; function getTextContent: wideString; virtual; function getXPathStringValue: wideString; virtual; function sendErrorNotification(const xmlErrorType: TXmlErrorType; const relNode: TdomNode): boolean; virtual; procedure setIsReadonly(const value: boolean); virtual; procedure setNodeValue(const value: wideString); virtual; procedure setPrefix(const value: wideString); virtual; function validate2: boolean; virtual; function validateIDREFS: boolean; virtual; public constructor create(const aOwner: TdomDocument); destructor destroy; override; function appendChild(const newChild: TdomNode): TdomNode; virtual; procedure clear; virtual; function cloneNode(const deep: boolean): TdomNode; virtual; function compareTreePosition(const other: TdomNode): TdomTreePosition; virtual; function evaluate(const expression: wideString): TdomXPathResult; virtual; function findFirstChildElement: TdomElement; virtual; function findLastChildElement: TdomElement; virtual; function findNextSiblingElement: TdomElement; virtual; function findParentElement: TdomElement; virtual; function findPreviousSiblingElement: TdomElement; virtual; function getFirstChildElement(const name: wideString): TdomElement; virtual; function getFirstChildElementNS(const namespaceURI, localName: wideString): TdomElement; virtual; function getLastChildElement(const name: wideString): TdomElement; virtual; function getLastChildElementNS(const namespaceURI, localName: wideString): TdomElement; virtual; function getNextSiblingElement(const name: wideString): TdomElement; virtual; function getNextSiblingElementNS(const namespaceURI, localName: wideString): TdomElement; virtual; function getParentElement(const name: wideString): TdomElement; virtual; function getParentElementNS(const namespaceURI, localName: wideString): TdomElement; virtual; function getPreviousSiblingElement(const name: wideString): TdomElement; virtual; function getPreviousSiblingElementNS(const namespaceURI, localName: wideString): TdomElement; virtual; function hasChildNodes: boolean; virtual; function insertBefore(const newChild, refChild: TdomNode): TdomNode; virtual; function isAncestor(const AncestorNode: TdomNode): boolean; virtual; procedure normalize; virtual; function removeChild(const oldChild: TdomNode): TdomNode; virtual; function replaceChild(const newChild, oldChild: TdomNode): TdomNode; virtual; function resolveEntityReferences(const opt: TdomEntityResolveOption): boolean; virtual; function supports(const feature, version: wideString): boolean; virtual; property attributes: TdomNamedNodeMap read getAttributes; property baseUri: wideString read getBaseUri; property childNodes: TdomNodeList read getChildNodes; property firstChild: TdomNode read getFirstChild; property isNamespaceNode: boolean read FIsNamespaceNode; property isReadonly: boolean read FIsReadonly; property lastChild: TdomNode read getLastChild; property localName: wideString read FLocalName; property namespaceURI: wideString read FNamespaceURI; property nextSibling: TdomNode read getNextSibling; property nodeName: wideString read getNodeName; property nodeType: TdomNodeType read getNodeType; property nodeValue: wideString read getNodeValue write setNodeValue; property ownerDocument: TdomDocument read getDocument; property parentNode: TdomNode read getParentNode; property previousSibling: TdomNode read getPreviousSibling; property prefix: wideString read FPrefix write setPrefix; property textContent: wideString read getTextContent; property XPathStringValue: wideString read getXPathStringValue; property onAttrModified: TdomAttrModifiedEvent read FOnAttrModified write FOnAttrModified; property onCharacterDataModified: TdomCharacterDataModifiedEvent read FOnCharacterDataModified write FOnCharacterDataModified; property onNodeInserted: TdomNodeModifiedEvent read FOnNodeInserted write FOnNodeInserted; property onNodeInsertedIntoDocument: TdomNodeModifiedEvent read FOnNodeInsertedIntoDocument write FOnNodeInsertedIntoDocument; property onNodeRemoved: TdomNodeModifiedEvent read FOnNodeRemoved write FOnNodeRemoved; property onNodeRemovedFromDocument: TdomNodeModifiedEvent read FOnNodeRemovedFromDocument write FOnNodeRemovedFromDocument; end; TdomCharacterData = class (TdomNode) private function getData: wideString; virtual; procedure setData(const Value: wideString); virtual; function getLength: integer; virtual; public constructor create(const aOwner: TdomDocument); virtual; function substringData(const offset, count: integer): wideString; virtual; procedure appendData(const arg: wideString); virtual; procedure insertData(const offset: integer; const arg: wideString); virtual; procedure deleteData(const offset, count: integer); virtual; procedure replaceData(const offset, count: integer; const arg: wideString); virtual; property data: wideString read getData write setData; property length: integer read getLength; end; TdomAttr = class (TdomNode) private FOwnerElement: TdomElement; FSpecified: boolean; protected function getLiteralValue: wideString; virtual; function getName: wideString; virtual; function getNextSibling: TdomNode; override; function getNodeValue: wideString; override; function getOwnerElement: TdomElement; virtual; function getParentNode: TdomNode; override; function getPreviousSibling: TdomNode; override; function getSpecified: boolean; virtual; function getValue: wideString; virtual; procedure setNodeValue(const value: wideString); override; procedure setValue(const value: wideString); virtual; function validate2: boolean; override; function validateIDREFS: boolean; override; public constructor create(const aOwner: TdomDocument; const name: wideString; const spcfd: boolean); constructor createNS(const aOwner: TdomDocument; const anamespaceURI, qualifiedName: wideString; const spcfd: boolean); procedure normalize; override; function resolveEntityReferences(const opt: TdomEntityResolveOption): boolean; override; property literalValue: wideString read getLiteralValue; property name: wideString read getName; property ownerElement: TdomElement read getOwnerElement; property specified: boolean read getSpecified; property value: wideString read getValue write setValue; end; TdomElement = class (TdomNode) private FCreatedElementsNodeLists: TList; FCreatedElementsNodeListNSs: TList; FAttributeListing: TList; FAttributeList: TdomNamedNodeMap; protected procedure setIsReadonly(const value: boolean); override; procedure setNodeValue(const value: wideString); override; function validate2: boolean; override; function validateIDREFS: boolean; override; public constructor create(const aOwner: TdomDocument; const tagName: wideString); constructor createNS(const aOwner: TdomDocument; const anamespaceURI, qualifiedName: wideString); destructor destroy; override; function getTagName: wideString; virtual; function getAttributes: TdomNamedNodeMap; override; function getAttribute(const name: wideString): wideString; virtual; function setAttribute(const name, value: wideString): TdomAttr; virtual; function removeAttribute(const name: wideString): TdomAttr; virtual; function getAttributeNode(const name: wideString): TdomAttr; virtual; function setAttributeNode(const newAttr: TdomAttr): TdomAttr; virtual; function removeAttributeNode(const oldAttr: TdomAttr): TdomAttr; virtual; function resolveEntityReferences(const opt: TdomEntityResolveOption): boolean; override; function getElementsByTagName(const name: wideString): TdomNodeList; virtual; function getAttributeNS(const anamespaceURI, alocalName: wideString): wideString; virtual; function setAttributeNS(const anamespaceURI, qualifiedName, value: wideString): TdomAttr; virtual; function removeAttributeNS(const anamespaceURI, alocalName: wideString): TdomAttr; virtual; function getAttributeNodeNS(const anamespaceURI, alocalName: wideString): TdomAttr; virtual; function setAttributeNodeNS(const newAttr: TdomAttr): TdomAttr; virtual; function getElementsByTagNameNS(const anamespaceURI, alocalName: wideString): TdomNodeList; virtual; function hasAttribute(const aname: wideString): boolean; virtual; function hasAttributeNS(const anamespaceURI, alocalName: wideString): boolean; virtual; procedure normalize; override; property tagName: wideString read getTagName; end; TdomText = class (TdomCharacterData) protected function getIsWhitespaceInElementContent: boolean; virtual; function validate2: boolean; override; public constructor create(const aOwner: TdomDocument); override; function splitText(const offset: integer): TdomText; virtual; property isWhitespaceInElementContent: boolean read getIsWhitespaceInElementContent; end; TdomComment = class (TdomCharacterData) protected function validate2: boolean; override; public constructor create(const aOwner: TdomDocument); override; end; TdomProcessingInstruction = class (TdomNode) private function getTarget: wideString; virtual; function getData: wideString; virtual; procedure setData(const value: wideString); virtual; protected function validate2: boolean; override; public constructor create(const aOwner: TdomDocument; const targ: wideString); virtual; property target: wideString read getTarget; property data: wideString read getData write setData; end; TdomCDATASection = class (TdomText) protected function validate2: boolean; override; public constructor create(const aOwner: TdomDocument); override; end; TdomDocumentType = class (TdomNode) private FInternalSubset: wideString; FPublicId: wideString; FSystemId: wideString; FEntitiesListing: TList; FEntitiesList: TdomNamedNodeMap; FNotationsListing: TList; FNotationsList: TdomNamedNodeMap; protected function getEntities: TdomNamedNodeMap; virtual; function getInternalSubset: wideString; virtual; function getName: wideString; virtual; function getNotations: TdomNamedNodeMap; virtual; function getPublicId: wideString; virtual; function getSystemId: wideString; virtual; procedure setNodeValue(const value: wideString); override; function validate2: boolean; override; public constructor create(const aOwner: TdomDocument; const name, pubId, sysId, intSubset: wideString); virtual; destructor destroy; override; property entities: TdomNamedNodeMap read getEntities; property internalSubset: wideString read getInternalSubset; property name: wideString read getName; property notations: TdomNamedNodeMap read getNotations; property publicId: wideString read getPublicId; property systemId: wideString read getSystemId; end; TdomNotation = class (TdomNode) private FPublicId: wideString; FSystemId: wideString; protected function getPublicId: wideString; virtual; function getSystemId: wideString; virtual; procedure setNodeValue(const value: wideString); override; public constructor create(const aOwner: TdomDocument; const name, pubId, sysId: wideString); virtual; property publicId: wideString read getPublicId; property systemId: wideString read getSystemId; end; TdomEntity = class (TdomNode) private FEncoding: wideString; FNotationName: wideString; FPublicId: wideString; FSystemId: wideString; FVersion: wideString; protected function getNotationName: wideString; virtual; procedure setNodeValue(const value: wideString); override; public constructor create(const aOwner: TdomDocument; const name, pubId, sysId, notaName: wideString); virtual; function insertBefore(const newChild, refChild: TdomNode): TdomNode; override; function replaceChild(const newChild, oldChild: TdomNode): TdomNode; override; function appendChild(const newChild: TdomNode): TdomNode; override; property encoding: wideString read FEncoding write FEncoding; property notationName: wideString read getNotationName; property publicId: wideString read FPublicId; property systemId: wideString read FSystemId; property version: wideString read FVersion write FVersion; end; TdomEntityReference = class (TdomNode) protected function expand: boolean; virtual; function getCorrespondingCMEntity: TdomCMEntity; virtual; function getRefersToPredefinedEntity: boolean; virtual; procedure setNodeValue(const value: wideString); override; function validate2: boolean; override; public constructor create(const aOwner: TdomDocument; const name: wideString); virtual; function cloneNode(const deep: boolean): TdomNode; override; function resolveEntityReferences(const opt: TdomEntityResolveOption): boolean; override; property correspondingCMEntity: TdomCMEntity read getCorrespondingCMEntity; property refersToPredefinedEntity: boolean read getRefersToPredefinedEntity; end; TdomDocumentFragment = class (TdomNode) protected procedure setNodeValue(const value: wideString); override; public constructor create(const aOwner: TdomDocument); virtual; end; TdomXPathNamespace = class (TdomNode) private FOwnerElement: TdomElement; protected function getDocument: TdomDocument; override; function getOwnerElement: TdomElement; virtual; public constructor create(const aOwnerElement: TdomElement; const anamespaceUri, aprefix: wideString); virtual; property ownerElement: TdomElement read getOwnerElement; end; TdomDocument = class (TdomNode) private FBaseUri: wideString; FCMInternal: TdomCMObject; FCreatedNodes: TList; FCreatedNodeIterators: TList; FCreatedTreeWalkers: TList; FCreatedElementsNodeLists: TList; FCreatedElementsNodeListNSs: TList; FCreatedExpressions: TList; FCreatedNSResolvers: TList; FDefaultView: TdomAbstractView; FDOMImpl: TDomImplementation; FEncoding: wideString; FIDs: TdomWideStringList; FModified: boolean; FStandalone: wideString; FSystemId: wideString; FVersion: wideString; procedure findNewReferenceNodes(const nodeToRemove: TdomNode); virtual; protected function createEntity(const name, pubId, sysId, notaName: wideString): TdomEntity; virtual; function createNotation(const name, pubId, sysId: wideString): TdomNotation; virtual; procedure doAttrModified(originalTarget: TdomNode; attrChange: TdomAttrChange; prevValue, newValue: wideString; relatedAttr: TdomAttr); override; procedure doCharacterDataModified(originalTarget: TdomNode; prevValue, newValue: wideString); override; procedure doNodeInserted(originalTarget: TdomNode); override; procedure doNodeRemoved(originalTarget: TdomNode); override; function getBaseUri: wideString; override; function getDoctype: TdomDocumentType; virtual; function getDocumentElement: TdomElement; virtual; procedure initDoc(const tagName: wideString); virtual; procedure initDocNS(const anamespaceURI, aqualifiedName: wideString); virtual; procedure setNodeValue(const value: wideString); override; function validateIDREFS: boolean; override; public constructor create(const aOwner: TDomImplementation); virtual; destructor destroy; override; function appendChild(const newChild: TdomNode): TdomNode; override; procedure clear; override; procedure clearInvalidNodeIterators; virtual; function createAttribute(const name: wideString): TdomAttr; virtual; function createAttributeNS(const anamespaceURI, aqualifiedName: wideString): TdomAttr; virtual; function createCDATASection(const data: wideString): TdomCDATASection; virtual; function createComment(const data: wideString): TdomComment; virtual; function createDocumentFragment: TdomDocumentFragment; virtual; function createDocumentType(const aname, pubId, sysId, intSubset: wideString): TdomDocumentType; virtual; function createElement(const tagName: wideString): TdomElement; virtual; function createElementNS(const anamespaceURI, aqualifiedName: wideString): TdomElement; virtual; function createEntityReference(const name: wideString): TdomEntityReference; virtual; function createExpression(const expression: wideString; const resolver: TdomXPathNSResolver): TdomXPathExpression; virtual; function createNodeIterator(const root: TdomNode; whatToShow: TdomWhatToShow; nodeFilter: TdomNodeFilter; entityReferenceExpansion: boolean): TdomNodeIterator; virtual; function createNSResolver(const nodeResolver: TdomNode): TdomXPathNSResolver; virtual; function createProcessingInstruction(const targ, data : wideString): TdomProcessingInstruction; virtual; function createTextNode(const data: wideString): TdomText; virtual; function createTreeWalker(const root: TdomNode; whatToShow: TdomWhatToShow; nodeFilter: TdomNodeFilter; entityReferenceExpansion: boolean): TdomTreeWalker; virtual; procedure freeAllNodes(var node: TdomNode); virtual; procedure freeExpression(var expression: TdomXPathExpression); virtual; procedure freeNSResolver(var resolver: TdomXPathNSResolver); virtual; procedure freeTreeWalker(var treeWalker: TdomTreeWalker); virtual; function getElementById(const elementId: wideString): TdomElement; virtual; function getElementsByTagName(const tagName: wideString): TdomNodeList; virtual; function getElementsByTagNameNS(const anamespaceURI, alocalName: wideString): TdomNodeList; virtual; function importNode(const importedNode: TdomNode; const deep: boolean): TdomNode; virtual; function insertBefore(const newChild, refChild: TdomNode): TdomNode; override; function removeContentModel: TdomCMObject; virtual; function replaceChild(const newChild, oldChild: TdomNode): TdomNode; override; procedure setBaseUri(const value: wideString); virtual; function setContentModel(const arg: TdomCMObject): TdomCMObject; virtual; function validate(const opt: TdomEntityResolveOption): boolean; virtual; property contentModel: TdomCMObject read FCMInternal; property defaultView: TdomAbstractView read FDefaultView; property doctype: TdomDocumentType read getDoctype; property documentElement: TdomElement read getDocumentElement; property domImplementation: TdomImplementation read FDomImpl; property encoding: wideString read FEncoding write FEncoding; property IDs: TdomWideStringList read FIDs; property modified: boolean read FModified write FModified; property standalone: wideString read FStandalone write FStandalone; property systemId: wideString read FSystemId write FSystemId; property version: wideString read FVersion write FVersion; end; TdomCMNode = class; TXmlInputSource = class; TdomSeverity = (DOM_SEVERITY_WARNING, DOM_SEVERITY_ERROR, DOM_SEVERITY_FATAL_ERROR); TdomError = class protected FCode: wideString; FLanguage: TIso639LanguageCode; FLocation: TdomLocator; FRelatedException: TXmlErrorType; FSupportedLanguages: TIso639LanguageCodeSet; function getDutchErrorStr: wideString; virtual; function getEnglishErrorStr: wideString; virtual; function getFrenchErrorStr: wideString; virtual; function getGermanErrorStr: wideString; virtual; function getItalianErrorStr: wideString; virtual; function getPolishErrorStr: wideString; virtual; function getPortugueseErrorStr: wideString; virtual; function getSpanishErrorStr: wideString; virtual; procedure setLanguage(const value: TIso639LanguageCode); virtual; function getMessage: wideString; virtual; function getSeverity: TdomSeverity; virtual; public constructor create(const errorType: TXmlErrorType; const startLine, startColumn, endLine, endColumn, offs: integer; const uriStr: wideString; const rCMNode: TdomCMNode; const rNode: TdomNode; const code: wideString); virtual; constructor createFromLocator(const errorType: TXmlErrorType; const location: TdomLocator; const code: wideString); virtual; destructor destroy; override; property code: wideString read FCode; property language: TIso639LanguageCode read FLanguage write setLanguage default iso639_en; property location: TdomLocator read FLocation; property relatedException: TXmlErrorType read FRelatedException; property message: wideString read getMessage; property severity: TdomSeverity read getSeverity; property supportedLanguages: TIso639LanguageCodeSet read FSupportedLanguages; end; TdomLocator = class protected FColumnNumber: integer; FOffset: integer; FStartColumnNumber: integer; FStartLineNumber: integer; FLineNumber: integer; FRelatedCMNode: TdomCMNode; FRelatedNode: TdomNode; FUri: wideString; function getColumnNumber: integer; virtual; function getLineNumber: integer; virtual; function getOffset: integer; virtual; function getRelatedCMNode: TdomCMNode; virtual; function getRelatedNode: TdomNode; virtual; function getStartColumnNumber: integer; virtual; function getStartLineNumber: integer; virtual; function getUri: wideString; virtual; public constructor create(const startLine, startColumn, endLine, endColumn, offset: integer; const uri: wideString; const rCMNode: TdomCMNode; const rNode: TdomNode); property columnNumber: integer read getColumnNumber; property lineNumber: integer read getLineNumber; property offset: integer read getOffset; property relatedCMNode: TdomCMNode read getRelatedCMNode; property relatedNode: TdomNode read getRelatedNode; property startColumnNumber: integer read getStartColumnNumber; property startLineNumber: integer read getStartLineNumber; property uri: wideString read getUri; end; TdomInputSourceLocator = class(TdomLocator) protected FInputSource: TXmlInputSource; FTabWidth: integer; function getOffset: integer; override; function getUri: wideString; override; procedure evaluate(const s: WideChar); virtual; procedure setStartMark; virtual; // This procedure is called by a Content Handler // to indicate that the properties startLineNumber // and startColumnNumber shall be set to the current // lineNumber and columnNumber. public constructor create(const inputSource: TXmlInputSource; const startLine, startColumn, endLine, endColumn, tabWidthValue: integer); virtual; property tabWidth: integer read FTabWidth; end; // Abstract Schema TdomASConstraintType = (AS_NO_VALUE_CONSTRAINT, AS_DEFAULT_VALUE_CONSTRAINT, AS_FIXED_VALUE_CONSTRAINT); TdomASContentType = (AS_EMPTY, AS_ANY, AS_MIXED, AS_ELEMENTS); TdomASDataType = (AS_STRING_DATATYPE, AS_BOOLEAN_DATATYPE, AS_FLOAT_DATATYPE, AS_DOUBLE_DATATYPE, AS_DECIMAL_DATATYPE, AS_HEXBINARY_DATATYPE, AS_BASE64BINARY_DATATYPE, AS_ANYURI_DATATYPE, AS_QNAME_DATATYPE, AS_DURATION_DATATYPE, AS_DATETIME_DATATYPE, AS_DATE_DATATYPE, AS_TIME_DATATYPE, AS_YEARMONTH_DATATYPE, AS_YEAR_DATATYPE, AS_MONTHDAY_DATATYPE, AS_DAY_DATATYPE, AS_MONTH_DATATYPE, AS_NOTATION_DATATYPE, AS_ID_DATATYPE, AS_IDREF_DATATYPE, AS_IDREFS_DATATYPE, AS_ENTITY_DATATYPE, AS_ENTITIES_DATATYPE, AS_NMTOKEN_DATATYPE, AS_NMTOKENS_DATATYPE, AS_SIMPLE_DATATYPE, AS_DERIVED_DATATYPE, AS_COMPLEX_DATATYPE); TdomASEntityType = (AS_INTERNAL_ENTITY, AS_EXTERNAL_ENTITY); TdomASListOperator = (AS_SEQUENCE, AS_CHOICE, AS_NONE); TdomASModelType = (AS_EXTERNAL_SUBSET, AS_INTERNAL_SUBSET, AS_NOT_USED); TdomASObjectType = (AS_UNKNOWN, AS_ATTRIBUTE_DECLARATION, AS_CONTENTMODEL, AS_ELEMENT_DECLARATION, AS_ENTITY_DECLARATION, AS_MODEL, AS_NOTATION_DECLARATION); TdomASObjectTypeSet = set of TdomASObjectType; TdomASModel = class; TdomASObject = class protected FASObjectName: wideString; FASObjectType: TdomASObjectType; FInuse: boolean; FLocalName: wideString; FNamespaceURI: wideString; FOwnerAsModel: TdomASModel; FPrefix: wideString; procedure setPrefix(const value: wideString); virtual; public constructor create(const aOwner: TdomASModel); property ASObjectName: wideString read FASObjectName; property ASObjectType: TdomASObjectType read FASObjectType; property localName: wideString read FLocalName; property namespaceURI: wideString read FNamespaceURI; property ownerASModel: TdomASModel read FOwnerAsModel; property prefix: wideString read FPrefix write setPrefix; end; TdomASObjectList = class private FNodeList: TList; protected procedure clear; function appendASNode(const newNode: TdomASObject): TdomASObject; virtual; procedure Delete(const index: integer); virtual; function indexOf(const node: TdomASObject): integer; virtual; function insertBefore(const newNode, refNode: TdomASObject): TdomASObject; virtual; function getLength: integer; virtual; function removeASNode(const oldNode: TdomASObject): TdomASObject; virtual; public constructor create; destructor destroy; override; function item(const index: integer): TdomASObject; virtual; property length: integer read getLength; end; TdomASNamedObjectMap = class protected FNamespaceAware: boolean; FNodeList: TList; FOwnerAsModel: TdomASModel; function getLength: integer; virtual; function removeNamedItem(const name: wideString): TdomASObject; virtual; function removeNamedItemNS(const namespaceURI, localName: wideString): TdomASObject; virtual; function setNamedItem(const arg: TdomASObject): TdomASObject; virtual; function setNamedItemNS(const arg: TdomASObject): TdomASObject; virtual; public constructor create(const aOwner: TdomASModel; const namespaceAware: boolean); destructor destroy; override; function getNamedItem(const name: wideString): TdomASObject; virtual; function getNamedItemNS(const namespaceURI, localName: wideString): TdomASObject; virtual; function item(const index: integer): TdomASObject; virtual; property length: integer read getLength; property isNamespaceAware: boolean read FNamespaceAware; property ownerASModel: TdomASModel read FOwnerAsModel; end; TdomASAttributeDeclaration = class(TdomASObject) private FAttrType: TdomASDataType; FAttrValue: wideString; FConstraintType: TdomASConstraintType; FEnumAttr: TdomWideStringList; function getIsNamespaceAware: boolean; public constructor create(const aOwner: TdomASModel; const name: wideString); constructor createNS(const aOwner: TdomASModel; const anamespaceURI, qualifiedName: wideString); destructor destroy; override; property attrType: TdomASDataType read FAttrType write FAttrType default AS_STRING_DATATYPE; property attrValue: wideString read FAttrValue write FAttrValue; property constraintType: TdomASConstraintType read FConstraintType write FConstraintType default AS_NO_VALUE_CONSTRAINT; property enumAttr: TdomWideStringList read FEnumAttr; property isNamespaceAware: boolean read getIsNamespaceAware; end; TdomASContentModel = class(TdomASObject) protected FListOperator: TdomASListOperator; FMaxOccurs: integer; FMinOccurs: integer; FSubModels: TdomASObjectList; public constructor create(const aOwner: TdomASModel); destructor destroy; override; function appendASNode(const newNode: TdomASObject): TdomASObject; virtual; function insertBefore(const newNode, refNode: TdomASObject): TdomASObject; virtual; function removeASNode(const oldNode: TdomASObject): TdomASObject; virtual; property listOperator: TdomASListOperator read FListOperator write FListOperator default AS_CHOICE; property maxOccurs: integer read FMaxOccurs write FMaxOccurs default AS_UNBOUND; property minOccurs: integer read FMinOccurs write FMinOccurs default 0; property subModels: TdomASObjectList read FSubModels; end; TdomASElementDeclaration = class(TdomASObject) protected FAttributeDeclarations: TdomASNamedObjectMap; FContentModel: TdomASContentModel; FContentType: TdomASContentType; FElementType: TdomASDataType; FIsPCDataOnly: boolean; FStrictMixedContent: boolean; function getIsNamespaceAware: boolean; public constructor create(const aOwner: TdomASModel; const name: wideString); constructor createNS(const aOwner: TdomASModel; const anamespaceURI, qualifiedName: wideString); destructor destroy; override; function addASAttributeDecl(const arg: TdomASAttributeDeclaration): boolean; virtual; function removeASAttributeDeclaration(const arg: TdomASAttributeDeclaration): TdomASAttributeDeclaration; virtual; property attributeDecls: TdomASNamedObjectMap read FAttributeDeclarations; property contentModel: TdomASContentModel read FContentModel; property contentType: TdomASContentType read FContentType write FContentType default AS_MIXED; property elementType: TdomASDataType read FElementType write FElementType default AS_STRING_DATATYPE; property isNamespaceAware: boolean read getIsNamespaceAware; property isPCDataOnly: boolean read FIsPCDataOnly write FIsPCDataOnly default false; property strictMixedContent: boolean read FStrictMixedContent write FStrictMixedContent default false; end; TdomASEntityDeclaration = class(TdomASObject) protected FEntityType: TdomASEntityType; FPublicId: wideString; FEntityValue: wideString; FSystemId: wideString; FNotationName: wideString; public constructor create(const aOwner: TdomASModel; const name: wideString); property entityType: TdomASEntityType read FEntityType write FEntityType default AS_INTERNAL_ENTITY; property entityValue: wideString read FEntityValue write FEntityValue; property notationName: wideString read FNotationName write FNotationName; property publicId: wideString read FPublicId write FPublicId; property systemId: wideString read FSystemId write FSystemId; end; TdomASNotationDeclaration = class(TdomASObject) protected FNotationName: wideString; FPublicId: wideString; FSystemId: wideString; public constructor create(const aOwner: TdomASModel; const name, pubId, sysId: wideString); constructor createNS(const aOwner: TdomASModel; const anamespaceURI, qualifiedName, pubId, sysId: wideString); property publicId: wideString read FPublicId; property systemId: wideString read FSystemId; end; TdomASModel = class (TdomASObject) protected FAttributeDeclarations: TdomASNamedObjectMap; FContentModelDeclarations: TdomASNamedObjectMap; FCreatedASNodes: TdomASObjectList; FDomImpl: TDomImplementation; FElementDeclarations: TdomASNamedObjectMap; FEntityDeclarations: TdomASNamedObjectMap; FNamespaceAware: boolean; FNotationDeclarations: TdomASNamedObjectMap; FHint: wideString; FLocation: wideString; FUsage: TdomASModelType; function getContainer: boolean; virtual; public constructor create(const aOwner: TDomImplementation; const namespaceAware: boolean); virtual; destructor destroy; override; function addNamedASElementDeclaration(const arg: TdomASElementDeclaration): boolean; virtual; function addNamedASEntityDeclaration(const arg: TdomASEntityDeclaration): boolean; virtual; function addNamedASNotationDeclaration(const arg: TdomASNotationDeclaration): boolean; virtual; procedure clear; virtual; function createASAttributeDeclaration(const anamespaceURI, qualifiedName: wideString): TdomASAttributeDeclaration; function createASContentModel: TdomASContentModel; function createASElementDeclaration(const anamespaceURI, qualifiedName: wideString): TdomASElementDeclaration; function createASEntityDeclaration(const name: wideString): TdomASEntityDeclaration; function createASNotationDeclaration(const name, pubId, sysId: wideString): TdomASNotationDeclaration; procedure freeAllASObjects(var obj: TdomASObject); virtual; function getNamedASElementDeclaration(const anamespaceURI, name: wideString): TdomASElementDeclaration; virtual; function getNamedASEntityDeclaration(const name: wideString): TdomASEntityDeclaration; virtual; function getNamedASNotationDeclaration(const anamespaceURI, name: wideString): TdomASNotationDeclaration; virtual; function removeNamedASElementDeclaration(const anamespaceURI, name: wideString): TdomASElementDeclaration; virtual; function removeNamedASEntityDeclaration(const name: wideString): TdomASEntityDeclaration; virtual; function removeNamedASNotationDeclaration(const anamespaceURI, name: wideString): TdomASNotationDeclaration; virtual; property attributeDecls: TdomASNamedObjectMap read FAttributeDeclarations; property container: boolean read getContainer; property contentModelDecls: TdomASNamedObjectMap read FContentModelDeclarations; property elementDecls: TdomASNamedObjectMap read FElementDeclarations; property entityDecls: TdomASNamedObjectMap read FEntityDeclarations; property hint: wideString read FHint write FHint; property isNamespaceAware: boolean read FNamespaceAware; property location: wideString read FLocation write FLocation; property notationDecls: TdomASNamedObjectMap read FNotationDeclarations; property usage: TdomASModelType read FUsage; end; // Content Model TdomCMNodeType = (ctUnknown, ctProcessingInstruction, ctComment, ctObject, ctFragment, ctExternalObject, ctInternalObject, ctAttribute, ctNotation, ctEntity, ctParameterEntityReference, ctEntityDeclaration, ctParameterEntityDeclaration, ctElementTypeDeclaration, ctSequenceParticle, ctChoiceParticle, ctPcdataChoiceParticle, ctElementParticle, ctAttributeList, ctAttributeDefinition, ctNotationDeclaration, ctNameParticle, ctNmtokenParticle); TdomCMNodeTypeSet = set of TdomCMNodeType; TdomCustomCMObject = class; TdomCMParameterEntityReference = class; TdomCMEntityDeclaration = class; TdomCMElementParticle = class; TdomCMNameParticle = class; TdomCMNmtokenParticle = class; TdomCMElementTypeDeclaration = class; TdomCMParameterEntityDeclaration = class; TdomCMFragment = class; TdomCMNotationDeclaration = class; TdomCMAttrDefinition = class; TdomCMAttrList = class; TdomCMChoiceParticle = class; TdomCMAttribute = class; TdomCMNotation = class; TdomCMPcdataChoiceParticle = class; TdomCMSequenceParticle = class; TdomCMNodeList = class private FCMNodeList: TList; function getLength: integer; virtual; protected function indexOf(const node: TdomCMNode): integer; virtual; public function item(const index: integer): TdomCMNode; virtual; constructor create(const CMNodeList: TList); property length: integer read getLength; end; TdomNamedCMNodeMap = class(TdomCMNodeList) private FOwner: TdomCMNode; // The owner content model. FOwnerNode: TdomCMNode; // The node to which the map is attached to. FIsReadonly: boolean; function getOwnerNode: TdomCMNode; virtual; protected FAllowedNodeTypes: TDomCMNodeTypeSet; function getNamedIndex(const name: wideString): integer; virtual; function removeItem(const arg: TdomCMNode): TdomCMNode; virtual; procedure setIsReadonly(const value: boolean); virtual; public constructor create(const aOwner, aOwnerNode: TdomCMNode; const nodeList: TList; const allowedNTs: TDomCMNodeTypeSet); virtual; function getNamedItem(const name: wideString): TdomCMNode; virtual; function setNamedItem(const arg: TdomCMNode): TdomCMNode; virtual; function removeNamedItem(const name: wideString): TdomCMNode; virtual; property isReadonly: boolean read FIsReadonly; property ownerNode: TdomCMNode read getOwnerNode; end; TdomNamedCMAttributeMap = class private FOwner: TdomCMObject; // The owner document. FCMAttributesList: TList; function getLength: integer; virtual; public constructor create(const aOwner: TdomCMObject); destructor destroy; override; function item(const index: integer): TdomCMAttribute; virtual; function getNamedItem(const elementName, attributeName: wideString): TdomCMAttribute; virtual; function appendNamedItem(const arg: TdomCMAttribute): boolean; virtual; function removeLastItem: TdomCMAttribute; virtual; property length: integer read getLength; property ownerContentModel: TdomCMObject read FOwner; end; TdomNamedCMEntityMap = class private FOwner: TdomCMObject; // The owner document. FCMEntitiesList: TList; function getLength: integer; virtual; public constructor create(const aOwner: TdomCMObject); destructor destroy; override; function item(const index: integer): TdomCMEntity; virtual; function getNamedItem(const name: wideString): TdomCMEntity; virtual; function appendNamedItem(const arg: TdomCMEntity): boolean; virtual; function removeLastItem: TdomCMEntity; virtual; property length: integer read getLength; property ownerContentModel: TdomCMObject read FOwner; end; TdomCMNode = class private FNodeName: wideString; FNodeValue: wideString; FNodeType: TdomCMNodeType; FCMNodeList: TdomCMNodeList; FCMNodeListing: TList; FCMObject: TdomCustomCMObject; FParentNode: TdomCMNode; FIsReadonly: boolean; function getCMNodeType: TdomCMNodeType; virtual; function getCMObject: TdomCustomCMObject; virtual; function getParentNode: TdomCMNode; virtual; function getChildNodes: TdomCMNodeList; virtual; function getFirstChild: TdomCMNode; virtual; function getLastChild: TdomCMNode; virtual; function getNextSibling: TdomCMNode; virtual; function getNodeName: wideString; virtual; function getNodeValue: wideString; virtual; function getPreviousSibling: TdomCMNode; virtual; procedure makeChildrenReadonly; virtual; procedure setNodeValue(const value: wideString); virtual; protected FAllowedChildTypes: set of TDomCMNodeType; function sendErrorNotification(const xmlErrorType: TXmlErrorType; const relCMNode: TdomCMNode): boolean; virtual; procedure setIsReadonly(const value: boolean); virtual; function validate: boolean; virtual; public constructor create(const aOwner: TdomCustomCMObject); destructor destroy; override; procedure clear; virtual; function insertBefore(const newChild, refChild: TdomCMNode): TdomCMNode; virtual; function replaceChild(const newChild, oldChild: TdomCMNode): TdomCMNode; virtual; function removeChild(const oldChild: TdomCMNode): TdomCMNode; virtual; function appendChild(const newChild: TdomCMNode): TdomCMNode; virtual; function hasChildNodes: boolean; virtual; function cloneNode(const deep: boolean): TdomCMNode; virtual; function isAncestor(const ancestorNode: TdomCMNode): boolean; virtual; property childNodes: TdomCMNodeList read getChildNodes; property firstChild: TdomCMNode read getFirstChild; property isReadonly: boolean read FIsReadonly; property lastChild: TdomCMNode read getLastChild; property nextSibling: TdomCMNode read getNextSibling; property nodeName: wideString read getNodeName; property nodeType: TdomCMNodeType read getCMNodeType; property nodeValue: wideString read getNodeValue write setNodeValue; property ownerCMObject: TdomCustomCMObject read getCMObject; property parentNode: TdomCMNode read getParentNode; property previousSibling: TdomCMNode read getPreviousSibling; end; TdomCMComment = class (TdomCMNode) private function getData: wideString; virtual; procedure setData(const value: wideString); virtual; function getLength: integer; virtual; protected function validate: boolean; override; public constructor create(const aOwner: TdomCustomCMObject); virtual; function substringData(const offset, count: integer):wideString; virtual; procedure appendData(const arg: wideString); virtual; procedure insertData(const offset: integer; const arg: wideString); virtual; procedure deleteData(const offset, count: integer); virtual; procedure replaceData(const offset, count: integer; const arg: wideString); virtual; property data: wideString read getData write setData; property length: integer read getLength; end; TdomCMProcessingInstruction = class (TdomCMNode) private function getTarget: wideString; virtual; function getData: wideString; virtual; procedure setData(const value: wideString); virtual; protected function validate: boolean; override; public constructor create(const aOwner: TdomCustomCMObject; const targ: wideString); virtual; property target: wideString read getTarget; property data: wideString read getData write setData; end; TdomCustomCMObject = class (TdomCMNode) private FCreatedNodes: TList; FDomImpl: TDomImplementation; FSystemId: wideString; procedure setNodeValue(const value: wideString); override; protected function duplicateCMNode(const node: TdomCMNode): TdomCMNode; virtual; public constructor create(const aOwner: TdomImplementation; const sysId: wideString); destructor destroy; override; function createCMAttributeDefinition(const name, attType, defaultDecl, attValue: wideString) : TdomCMAttrDefinition; virtual; function createCMAttributeList(const name: wideString): TdomCMAttrList; virtual; function createCMChoiceParticle(const freq: wideString): TdomCMChoiceParticle; virtual; function createCMComment(const data: wideString): TdomCMComment; virtual; function createCMElementParticle(const name, freq: wideString): TdomCMElementParticle; virtual; function createCMElementTypeDeclaration(const name: wideString; const ContspecType: TdomContentspecType): TdomCMElementTypeDeclaration; virtual; function createCMExtEntityDeclaration(const name, pubId, sysId: wideString): TdomCMEntityDeclaration; virtual; function createCMExtParameterEntityDeclaration(const name, pubId, sysId: wideString): TdomCMParameterEntityDeclaration; virtual; function createCMExtUnparsedEntityDeclaration(const name, pubId, sysId, notaName: wideString): TdomCMEntityDeclaration; virtual; function createCMFragment: TdomCMFragment; virtual; function createCMIntEntityDeclaration(const name, entityValue: wideString): TdomCMEntityDeclaration; virtual; function createCMIntParameterEntityDeclaration(const name, entityValue: wideString): TdomCMParameterEntityDeclaration; virtual; function createCMNameParticle(const name: wideString): TdomCMNameParticle; virtual; function createCMNmtokenParticle(const name: wideString): TdomCMNmtokenParticle; virtual; function createCMNotationDeclaration(const name, pubId, sysId: wideString): TdomCMNotationDeclaration; virtual; function createCMParameterEntityReference(const name: wideString): TdomCMParameterEntityReference; virtual; function createCMPcdataChoiceParticle: TdomCMPcdataChoiceParticle; virtual; function createCMProcessingInstruction(const targ, data : wideString): TdomCMProcessingInstruction; virtual; function createCMSequenceParticle(const freq: wideString): TdomCMSequenceParticle; virtual; procedure freeAllCMNodes(var CMNode: TdomCMNode); virtual; procedure getValueOfPE(const name: wideString; var value: wideString; var error: TXmlErrorType); virtual; function hasPEDeclaration(const name: wideString): boolean; virtual; property domImplementation: TdomImplementation read FDomImpl; property systemId: wideString read FSystemId write FSystemId; end; TdomCMObject = class (TdomCustomCMObject) private FAssociatedDocument: TdomDocument; FAttributesList: TdomNamedCMAttributeMap; FCMExternal: TdomCMExternalObject; FCMInternal: TdomCMInternalObject; FEntitiesList: TdomNamedCMEntityMap; FNotationsList: TdomNamedCMNodeMap; FNotationsListing: TList; FElementTypesList: TdomNamedCMNodeMap; FElementTypesListing: TList; procedure clearAttributes; procedure clearElementTypes; procedure clearEntities; procedure clearNotations; protected function createCMAttribute(const elementName, attributeName, attType, defaultDecl, attValue: wideString): TdomCMAttribute; virtual; function createCMExtParsedEntity(const name, pubId, sysId: wideString): TdomCMEntity; virtual; function createCMExtUnparsedEntity(const name, pubId, sysId, notaName: wideString): TdomCMEntity; virtual; function createCMIntEntity(const name, literalValue: wideString): TdomCMEntity; virtual; function createCMNotation(const name, pubId, sysId: wideString): TdomCMNotation; virtual; function duplicateCMNode(const node: TdomCMNode): TdomCMNode; override; function prepareCM: boolean; virtual; function setPredefinedEntities: boolean; virtual; public constructor create(const aOwner: TdomImplementation; const sysId: wideString); virtual; destructor destroy; override; procedure clear; override; function prepare: boolean; virtual; function removeExternalCM: TdomCMExternalObject; virtual; function removeInternalCM: TdomCMInternalObject; virtual; function setExternalCM(const arg: TdomCMExternalObject): TdomCMExternalObject; virtual; function setInternalCM(const arg: TdomCMInternalObject): TdomCMInternalObject; virtual; function validate: boolean; override; property associatedDocument: TdomDocument read FAssociatedDocument; property attributes: TdomNamedCMAttributeMap read FAttributesList; property elementTypes: TdomNamedCMNodeMap read FElementTypesList; property entities: TdomNamedCMEntityMap read FEntitiesList; property externalCM: TdomCMExternalObject read FCMExternal; property internalCM: TdomCMInternalObject read FCMInternal; property notations: TdomNamedCMNodeMap read FNotationsList; end; TdomCustomCMIEObject = class (TdomCustomCMObject) protected FAssociatedContentModel: TdomCMObject; FPublicId: wideString; function validate: boolean; override; public constructor create(const aOwner: TdomImplementation; const pubId, sysId: wideString); property associatedContentModel: TdomCMObject read FAssociatedContentModel; property publicId: wideString read FPublicId write FPublicId; end; TdomCMInternalObject = class (TdomCustomCMIEObject) public constructor create(const aOwner: TdomImplementation; const pubId, sysId: wideString); end; TdomCMExternalObject = class (TdomCustomCMIEObject) protected FEncoding: wideString; FVersion: wideString; public constructor create(const aOwner: TdomImplementation; const pubId, sysId: wideString); property encoding: wideString read FEncoding write FEncoding; property version: wideString read FVersion write FVersion; end; TdomCMNotationDeclaration = class (TdomCMNode) private FPublicId: wideString; FSystemId: wideString; function getPublicId: wideString; virtual; function getSystemId: wideString; virtual; procedure setNodeValue(const value: wideString); override; protected function validate: boolean; override; public constructor create(const aOwner: TdomCustomCMObject; const name, pubId, sysId: wideString); virtual; property publicId: wideString read getPublicId; property systemId: wideString read getSystemId; end; TdomCMElementTypeDeclaration = class (TdomCMNode) private FContentspec: TdomContentspecType; function getContentspec: wideString; virtual; function getContentspecType: TdomContentspecType; virtual; procedure setNodeValue(const value: wideString); override; protected function validate: boolean; override; public constructor create(const aOwner: TdomCustomCMObject; const name: wideString; const contspecType: TdomContentspecType); virtual; function appendChild(const newChild: TdomCMNode): TdomCMNode; override; function insertBefore(const newChild, refChild: TdomCMNode): TdomCMNode; override; property contentspec: wideString read getContentspec; property contentspecType: TdomContentspecType read getContentspecType; end; TdomCMAttrList = class(TdomCMNode) protected function validate: boolean; override; public constructor create(const aOwner: TdomCustomCMObject; const name: wideString); virtual; end; TdomCMAttrDefinition = class(TdomCMNode) private FAttributeType: wideString; FDefaultDeclaration: wideString; FParentAttributeList: TdomCMAttrList; function getAttributeType: wideString; virtual; function getDefaultDeclaration: wideString; virtual; procedure setNodeValue(const value: wideString); override; protected function validate: boolean; override; public constructor create(const aOwner: TdomCustomCMObject; const name, attType, defaultDecl, attValue: wideString); virtual; property attributeType: wideString read getAttributeType; property defaultDeclaration: wideString read getDefaultDeclaration; end; TdomCMParticle = class (TdomCMNode) private FFrequency: wideString; function contentModelTest2(const source, rest: TdomWideStringList; const freq: wideString; var isNonDeterministic: boolean): boolean; virtual; function contentModelTest(const source, rest: TdomWideStringList; var isNonDeterministic: boolean): boolean; virtual; function getFrequency: wideString; virtual; procedure setFrequency(const freq: wideString); virtual; procedure setNodeValue(const value: wideString); override; procedure writeCode(stream: TStream); virtual; abstract; public constructor create(const aOwner: TdomCustomCMObject; const freq: wideString); property frequency: wideString read getFrequency; end; TdomCMSequenceParticle = class (TdomCMParticle) private function contentModelTest2(const source, rest: TdomWideStringList; const freq: wideString; var isNonDeterministic: boolean): boolean; override; procedure writeCode(stream: TStream); override; protected function validate: boolean; override; public constructor create(const aOwner: TdomCustomCMObject; const freq: wideString); virtual; end; TdomCMChoiceParticle = class (TdomCMParticle) private function contentModelTest2(const source, rest: TdomWideStringList; const freq: wideString; var isNonDeterministic: boolean): boolean; override; procedure writeCode(stream: TStream); override; protected function validate: boolean; override; public constructor create(const aOwner: TdomCustomCMObject; const freq: wideString); virtual; end; TdomCMPcdataChoiceParticle = class (TdomCMParticle) private function contentModelTest(const source, rest: TdomWideStringList; var isNonDeterministic: boolean): boolean; override; procedure setFrequency(const freq: wideString); override; procedure writeCode(stream: TStream); override; protected function validate: boolean; override; public constructor create(const aOwner: TdomCustomCMObject; const freq: wideString); virtual; function elementDefined(const elementName: wideString): boolean; end; TdomCMElementParticle = class (TdomCMParticle) private function contentModelTest2(const source, rest: TdomWideStringList; const freq: wideString; var isNonDeterministic: boolean): boolean; override; procedure writeCode(stream: TStream); override; protected function validate: boolean; override; public constructor create(const aOwner: TdomCustomCMObject; const name, freq: wideString); virtual; end; TdomCMNameParticle = class (TdomCMNode) private procedure setNodeValue(const value: wideString); override; protected function validate: boolean; override; public constructor create(const aOwner: TdomCustomCMObject; const name: wideString); virtual; end; TdomCMNmtokenParticle = class (TdomCMNode) private procedure setNodeValue(const value: wideString); override; protected function validate: boolean; override; public constructor create(const aOwner: TdomCustomCMObject; const name: wideString); virtual; end; TdomCMAttribute = class (TdomCMNode) private FAttributeName: wideString; FAttributeType: wideString; FDefaultDeclaration: wideString; FElementName: wideString; procedure setNodeValue(const value: wideString); override; public constructor create(const aOwner: TdomCustomCMObject; const elementName, attributeName, attType, defaultDecl, attValue: wideString); virtual; property attributeName: wideString read FAttributeName; property attributeType: wideString read FAttributeType; property defaultDeclaration: wideString read FDefaultDeclaration; property elementName: wideString read FElementName; end; TdomCMNotation = class (TdomCMNode) private FPublicId: wideString; FSystemId: wideString; public constructor create(const aOwner: TdomCustomCMObject; const name, pubId, sysId: wideString); virtual; property publicId: wideString read FPublicId; property systemId: wideString read FSystemId; end; TdomCMEntity = class (TdomCMNode) private FEncoding: wideString; FEntityType: TdomEntityType; FIsParsedEntity: boolean; FLiteralValue: wideString; FNotationName: wideString; FPublicId: wideString; FSystemId: wideString; function refersToXyz(const allowUnresolvableEntities: boolean; const previousEntities: TdomWideStringList; const whatToTest: integer): boolean; procedure calculateLiteralValue(const S: wideString); procedure setNodeValue(const value: wideString); override; protected FReplacementText: wideString; FIsUnusable: boolean; // xxx can be problematic! FIsResolved: boolean; function getIsUnusable: boolean; virtual; function getLiteralValue: wideString; virtual; function getNormalizedValue: wideString; virtual; function getReplacementText: wideString; virtual; function refersToItself(const allowUnresolvableEntities: boolean): boolean; virtual; function refersToExternalEntity(const allowUnresolvableEntities: boolean): boolean; virtual; function refersToUnparsedEntity(const allowUnresolvableEntities: boolean): boolean; virtual; function refersToUnusableEntity(const allowUnresolvableEntities: boolean): boolean; virtual; public constructor create(const aOwner: TdomCustomCMObject; const name, litValue: wideString); virtual; constructor createExtParsed(const aOwner: TdomCustomCMObject; const name, pubId, sysId: wideString); virtual; constructor createExtUnparsed(const aOwner: TdomCustomCMObject; const name, pubId, sysId, notaName: wideString); virtual; function resolve: boolean; virtual; property encoding: wideString read FEncoding write FEncoding; property entityType: TdomEntityType read FEntityType; property isParsedEntity: boolean read FIsParsedEntity; property isResolved: boolean read FIsResolved; property isUnusable: boolean read getIsUnusable; property literalValue: wideString read getLiteralValue; property normalizedValue: wideString read getNormalizedValue; property notationName: wideString read FNotationName; property publicId: wideString read FPublicId; property replacementText: wideString read getReplacementText; property systemId: wideString read FSystemId; end; TdomCustomCMEntDecl = class (TdomCMNode) private FEntityType: TdomEntityType; FPublicId: wideString; FSystemId: wideString; function getEntityType: TdomEntityType; virtual; function getPublicId: wideString; virtual; function getSystemId: wideString; virtual; public constructor create(const aOwner: TdomCustomCMObject; const name, litValue: wideString); virtual; constructor createExtParsed(const aOwner: TdomCustomCMObject; const name, pubId, sysId: wideString); virtual; function insertBefore(const newChild, refChild: TdomCMNode): TdomCMNode; override; function replaceChild(const newChild, oldChild: TdomCMNode): TdomCMNode; override; function appendChild(const newChild: TdomCMNode): TdomCMNode; override; property entityType: TdomEntityType read getEntityType; property publicId: wideString read getPublicId; property systemId: wideString read getSystemId; end; TdomCMEntityDeclaration = class (TdomCustomCMEntDecl) private FIsParsedEntity: boolean; FNotationName: wideString; protected function validate: boolean; override; public constructor create(const aOwner: TdomCustomCMObject; const name, litValue: wideString); override; constructor createExtParsed(const aOwner: TdomCustomCMObject; const name, pubId, sysId: wideString); override; constructor createExtUnparsed(const aOwner: TdomCustomCMObject; const name, pubId, sysId, notaName: wideString); virtual; property isParsedEntity: boolean read FIsParsedEntity; property notationName: wideString read FNotationName; end; TdomCMParameterEntityDeclaration = class (TdomCustomCMEntDecl) protected function validate: boolean; override; public constructor create(const aOwner: TdomCustomCMObject; const name, litValue: wideString); override; constructor createExtParsed(const aOwner: TdomCustomCMObject; const name, pubId, sysId: wideString); override; end; TdomCMParameterEntityReference = class (TdomCMNode) private procedure setNodeValue(const value: wideString); override; protected function validate: boolean; override; public constructor create(const aOwner: TdomCustomCMObject; const name: wideString); virtual; end; TdomCMFragment = class (TdomCMNode) private procedure setNodeValue(const value: wideString); override; public constructor create(const aOwner: TdomCustomCMObject); virtual; end; // Views TdomAbstractView = class protected FDocument: TdomDocument; public property document: TdomDocument read FDocument; end; TdomStyleSheet = class private function getStyleSheetType: wideString; virtual; abstract; function getDisabled: boolean; virtual; abstract; procedure setDisabled(const value: boolean); virtual; abstract; function getOwnerNode: TdomNode; virtual; abstract; function getParentStyleSheet: TdomStyleSheet; virtual; abstract; function getHref: wideString; virtual; abstract; function getTitle: wideString; virtual; abstract; function getMedia: TdomMediaList; virtual; abstract; public property styleSheetType: wideString read getStyleSheetType; property disabled: boolean read getDisabled write setDisabled; property ownerNode: TdomNode read getOwnerNode; property parentStyleSheet: TdomStyleSheet read getParentStyleSheet; property href: wideString read getHref; property title: wideString read getTitle; property media: TdomMediaList read getMedia; end; TdomMediaList = class private function getCssText: wideString; virtual; abstract; procedure setCssText(const value: wideString); virtual; abstract; function getLength: integer; virtual; abstract; public function item(const index: integer): TdomStyleSheet; virtual; abstract; procedure Delete(const oldMedium: wideString); virtual; abstract; procedure append(const newMedium: wideString); virtual; abstract; property length: integer read getLength; property cssText: wideString read getCssText write setCssText; end; TdomStyleSheetList = class private function getLength: integer; virtual; abstract; public function item(const index: integer): TdomStyleSheet; virtual; abstract; property length: integer read getLength; end; TdomDocumentStyle = class private function getStyleSheets: TdomStyleSheetList; virtual; abstract; public property styleSheets: TdomStyleSheetList read getStyleSheets; end; TXmlSourceCode = class (TList) private procedure calculatePieceOffset(const startItem: integer); virtual; function getNameOfFirstTag: wideString; virtual; public function add(Item: Pointer): integer; procedure clear; {$ifdef ver100} virtual; {$else} override; {$endif} // ifdef... is necessary because TList.clear is static in Delphi 3 // (=ver100), but dynamic in later versions. procedure clearAndFree; virtual; procedure Delete(index: integer); procedure exchange(index1, index2: integer); function getPieceAtPos(pos: integer): TXmlSourceCodePiece; procedure insert(index: integer; item: pointer); procedure move(curIndex, newIndex: integer); procedure pack; function remove(Item: Pointer): integer; procedure sort(Compare: TListSortCompare); property nameOfFirstTag: wideString read getNameOfFirstTag; end; TXmlSourceCodePiece = class private FPieceType: TdomPieceType; FText: wideString; FOffset: integer; FOwner: TXmlSourceCode; public constructor create(const pt: TdomPieceType); virtual; property pieceType: TdomPieceType read FPieceType; property text: wideString read FText write FText; property offset: integer read FOffset; property ownerSourceCode: TXmlSourceCode read FOwner; end; {Parser} TdomStandalone = ( STANDALONE_YES, STANDALONE_NO, STANDALONE_UNSPECIFIED); TdomXMLDeclType = ( DT_UNKNOWN, DT_XML_DECLARATION, DT_TEXT_DECLARATION, DT_XML_OR_TEXT_DECLARATION, DT_UNSPECIFIED ); TXmlInputSource = class private FDeclType: TdomXMLDeclType; FEncoding: TdomEncodingType; FEncodingName: wideString; FHasMalformedDecl: boolean; FLastCharWasCR: boolean; FLastUcs4: integer; // Buffer storage for UTF-8 surrogates FLocator: TdomInputSourceLocator; FPublicId: wideString; FStandalone: TdomStandalone; FStartPosition: integer; FStream: TStream; FSystemId: wideString; FVersionNumber: wideString; function evaluateXmlOrTextDecl(const tabWidthValue: integer; out declType: TdomXMLDeclType; out encodingType: TdomEncodingType; out versionInfo, encName: wideString; out standalone: TdomStandalone; out lineOffset, columnOffset: integer): boolean; protected function getStreamAsWideString: wideString; virtual; function getNextWideChar2(var dest: wideChar; const enc: TdomEncodingType; const locator: TdomInputSourceLocator): boolean; virtual; public constructor create(const stream: TStream; const publicId, systemId: wideString; const tabWidthValue: integer); virtual; destructor destroy; override; function getNextWideChar(var dest: wideChar): boolean; virtual; property declType: TdomXMLDeclType read FDeclType; property encoding: TdomEncodingType read FEncoding; property encodingName: wideString read FEncodingName; property hasMalformedDecl: boolean read FHasMalformedDecl; property locator: TdomInputSourceLocator read FLocator; property publicId: wideString read FPublicId; property standalone: TdomStandalone read FStandalone; property stream: TStream read FStream; property streamAsWideString: wideString read getStreamAsWideString; property systemId: wideString read FSystemId; property versionNumber: wideString read FVersionNumber; end; TXmlCustomParser = class; TXmlToDomParser = class; TXmlCustomReader = class; TXmlStandardDocReader = class; TXmlStandardDtdReader = class; TXmlProcessorEvent1 = procedure(reader: TXmlCustomReader; locator: TdomLocator) of object; TXmlProcessorEvent2 = procedure(reader: TXmlCustomReader; locator: TdomLocator; var data: wideString) of object; TXmlProcessorEvent3 = procedure(reader: TXmlCustomReader; locator: TdomLocator; var targ, data : wideString) of object; TXmlProcessorEvent4 = procedure(reader: TXmlCustomReader; locator: TdomLocator; var namespaceURI, tagName: wideString) of object; TXmlProcessorEvent5 = procedure(reader: TXmlCustomReader; locator: TdomLocator; var namespaceURI, tagName: wideString; attributes: TdomNameValueList) of object; TXmlProcessorEvent6 = procedure(reader: TXmlCustomReader; locator: TdomLocator; var name, pubId, sysId, data: wideString) of object; TXmlProcessorEvent7 = procedure(reader: TXmlCustomReader; locator: TdomLocator; var prefix, uri: wideString) of object; TXmlProcessorEvent8 = procedure(reader: TXmlCustomReader; locator: TdomLocator; var version, encDl, sdDl: wideString) of object; TXmlProcessorEvent9 = procedure(reader: TXmlCustomReader; locator: TdomLocator; var name, attType, bracket, defaultDecl, attValue: wideString) of object; TXmlProcessorEvent10 = procedure(reader: TXmlCustomReader; locator: TdomLocator; var includeStmt, data: wideString) of object; TXmlProcessorEvent11 = procedure(reader: TXmlCustomReader; locator: TdomLocator; var name, data: wideString) of object; TXmlProcessorEvent12 = procedure(reader: TXmlCustomReader; locator: TdomLocator; var name, entityValue, pubId, sysId, notaName: wideString) of object; TXmlProcessorEvent13 = procedure(reader: TXmlCustomReader; locator: TdomLocator; var name, pubId, sysId: wideString) of object; TXmlProcessorEvent14 = procedure(reader: TXmlCustomReader; locator: TdomLocator; var name, entityValue, pubId, sysId: wideString) of object; TXmlProcessorEvent15 = procedure(reader: TXmlCustomReader; locator: TdomLocator; var version, encDl: wideString) of object; TXmlProcessorEvent16 = procedure(reader: TXmlCustomReader; locator: TdomLocator; var version, encDl: wideString; var sdDl: TdomStandalone) of object; TXmlCustomHandler = class(TComponent) protected FOnComment: TXmlProcessorEvent2; FOnCDATA: TXmlProcessorEvent2; FOnCharRef: TXmlProcessorEvent2; FOnDoctype: TXmlProcessorEvent6; FOnEndDocument: TXmlProcessorEvent1; FOnEndElement: TXmlProcessorEvent4; FOnEndPrefixMapping: TXmlProcessorEvent2; FOnEntityRef: TXmlProcessorEvent2; FOnPCDATA: TXmlProcessorEvent2; FOnProcessingInstruction: TXmlProcessorEvent3; FOnSkippedEntity: TXmlProcessorEvent2; FOnStartDocument: TXmlProcessorEvent16; FOnStartElement: TXmlProcessorEvent5; FOnStartPrefixMapping: TXmlProcessorEvent7; FOnAttributeDefinition: TXmlProcessorEvent9; FOnConditionalSection: TXmlProcessorEvent10; FOnDtdComment: TXmlProcessorEvent2; FOnDtdProcessingInstruction: TXmlProcessorEvent3; FOnElementTypeDeclaration: TXmlProcessorEvent11; FOnEndAttListDeclaration: TXmlProcessorEvent1; FOnEndExtDtd: TXmlProcessorEvent1; FOnEndIntDtd: TXmlProcessorEvent1; FOnEntityDeclaration: TXmlProcessorEvent12; FOnNotationDeclaration: TXmlProcessorEvent13; FOnParameterEntityDeclaration: TXmlProcessorEvent14; FOnParameterEntityRef: TXmlProcessorEvent2; FOnStartAttListDeclaration: TXmlProcessorEvent2; FOnStartExtDtd: TXmlProcessorEvent15; FOnStartIntDtd: TXmlProcessorEvent1; function sendErrorNotification(const target: TXmlCustomReader; const xmlErrorType: TXmlErrorType; const location: TdomLocator; const code: wideString): boolean; virtual; public function CDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; virtual; abstract; function charRef(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; virtual; abstract; function comment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; virtual; abstract; function doctype(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId, data: wideString): boolean; virtual; abstract; function endDocument(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; virtual; abstract; function endElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString): boolean; virtual; abstract; function endPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix: wideString): boolean; virtual; abstract; function entityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; virtual; abstract; function PCDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; virtual; abstract; function processingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; virtual; abstract; function skippedEntity(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; virtual; abstract; function startDocument(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString; sdDl: TdomStandalone): boolean; virtual; abstract; function startElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString; attributes: TdomNameValueList): boolean; virtual; abstract; function startPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix, uri: wideString): boolean; virtual; abstract; function attributeDefinition(const sender: TXmlCustomReader; const locator: TdomLocator; aname, attType, bracket, defaultDecl, attValue: wideString): boolean; virtual; abstract; function conditionalSection(const sender: TXmlCustomReader; const locator: TdomLocator; includeStmt, data: wideString): boolean; virtual; abstract; function DTDcomment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; virtual; abstract; function DTDprocessingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; virtual; abstract; function elementTypeDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, data: wideString): boolean; virtual; abstract; function endAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; virtual; abstract; function endExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; virtual; abstract; function endIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; virtual; abstract; function entityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId, notaName: wideString): boolean; virtual; abstract; function notationDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId: wideString): boolean; virtual; abstract; function parameterEntityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId: wideString): boolean; virtual; abstract; function parameterEntityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; virtual; abstract; function startAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; virtual; abstract; function startExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString): boolean; virtual; abstract; function startIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; virtual; abstract; function resolvePE( PEReferenceName: wideString; var PEValue: wideString; var error: TXmlErrorType): boolean; virtual; abstract; procedure notifyReset; virtual; abstract; published property OnAttributeDefinition: TXmlProcessorEvent9 read FOnAttributeDefinition write FOnAttributeDefinition; property OnCDATA: TXmlProcessorEvent2 read FOnCDATA write FOnCDATA; property OnCharRef: TXmlProcessorEvent2 read FOnCharRef write FOnCharRef; property OnComment: TXmlProcessorEvent2 read FOnComment write FOnComment; property OnConditionalSection: TXmlProcessorEvent10 read FOnConditionalSection write FOnConditionalSection; property OnDoctype: TXmlProcessorEvent6 read FOndoctype write FOndoctype; property OnDtdComment: TXmlProcessorEvent2 read FOnDtdComment write FOnDtdComment; property OnDtdProcessingInstruction: TXmlProcessorEvent3 read FOnDtdProcessingInstruction write FOnDtdProcessingInstruction; property OnElementTypeDeclaration: TXmlProcessorEvent11 read FOnElementTypeDeclaration write FOnElementTypeDeclaration; property OnEndAttListDeclaration: TXmlProcessorEvent1 read FOnEndAttListDeclaration write FOnEndAttListDeclaration; property OnEndDocument: TXmlProcessorEvent1 read FOnEndDocument write FOnEndDocument; property OnEndElement: TXmlProcessorEvent4 read FOnEndElement write FOnEndElement; property OnEndExtDtd: TXmlProcessorEvent1 read FOnEndExtDtd write FOnEndExtDtd; property OnEndIntDtd: TXmlProcessorEvent1 read FOnEndIntDtd write FOnEndIntDtd; property OnEndPrefixMapping: TXmlProcessorEvent2 read FOnEndPrefixMapping write FOnEndPrefixMapping; property OnEntityDeclaration: TXmlProcessorEvent12 read FOnEntityDeclaration write FOnEntityDeclaration; property OnEntityRef: TXmlProcessorEvent2 read FOnEntityRef write FOnEntityRef; property OnNotationDeclaration: TXmlProcessorEvent13 read FOnNotationDeclaration write FOnNotationDeclaration; property OnParameterEntityDeclaration: TXmlProcessorEvent14 read FOnParameterEntityDeclaration write FOnParameterEntityDeclaration; property OnParameterEntityRef: TXmlProcessorEvent2 read FOnParameterEntityRef write FOnParameterEntityRef; property OnPCDATA: TXmlProcessorEvent2 read FOnPCDATA write FOnPCDATA; property OnProcessingInstruction: TXmlProcessorEvent3 read FOnProcessingInstruction write FOnProcessingInstruction; property OnSkippedEntity: TXmlProcessorEvent2 read FOnSkippedEntity write FOnSkippedEntity; property OnStartAttListDeclaration: TXmlProcessorEvent2 read FOnStartAttListDeclaration write FOnStartAttListDeclaration; property OnStartDocument: TXmlProcessorEvent16 read FOnStartDocument write FOnStartDocument; property OnStartElement: TXmlProcessorEvent5 read FOnStartElement write FOnStartElement; property OnStartExtDtd: TXmlProcessorEvent15 read FOnStartExtDtd write FOnStartExtDtd; property OnStartIntDtd: TXmlProcessorEvent1 read FOnStartIntDtd write FOnStartIntDtd; property OnStartPrefixMapping: TXmlProcessorEvent7 read FOnStartPrefixMapping write FOnStartPrefixMapping; end; TXmlStandardHandler = class(TXmlCustomHandler) protected FNextHandler: TXmlCustomHandler; procedure Notification(AComponent: TComponent; Operation: TOperation); override; public function CDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function charRef(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function comment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function doctype(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId, data: wideString): boolean; override; function endDocument(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString): boolean; override; function endPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix: wideString): boolean; override; function entityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function PCDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function processingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; override; function skippedEntity(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startDocument(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString; sdDl: TdomStandalone): boolean; override; function startElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString; attributes: TdomNameValueList): boolean; override; function startPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix, uri: wideString): boolean; override; function attributeDefinition(const sender: TXmlCustomReader; const locator: TdomLocator; aname, attType, bracket, defaultDecl, attValue: wideString): boolean; override; function conditionalSection(const sender: TXmlCustomReader; const locator: TdomLocator; includeStmt, data: wideString): boolean; override; function DTDcomment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function DTDprocessingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; override; function elementTypeDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, data: wideString): boolean; override; function endAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function entityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId, notaName: wideString): boolean; override; function notationDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId: wideString): boolean; override; function parameterEntityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId: wideString): boolean; override; function parameterEntityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString): boolean; override; function startIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function resolvePE( PEReferenceName: wideString; var PEValue: wideString; var error: TXmlErrorType): boolean; override; procedure notifyReset; override; published property NextHandler: TXmlCustomHandler read FNextHandler write FNextHandler; end; TXmlDistributor = class; TXmlHandlerItem = class(TCollectionItem) protected FXmlHandler: TXmlCustomHandler; function getXmlHandler: TXmlCustomHandler; procedure setXmlHandler(Value: TXmlCustomHandler); public procedure Assign(Source: TPersistent); override; published property XmlHandler: TXmlCustomHandler read getXmlHandler write setXmlHandler; end; TXmlHandlers = class(TCollection) private FDistributor: TXmlDistributor; protected function GetItem(Index: Integer): TXmlHandlerItem; virtual; procedure SetItem(Index: Integer; Value: TXmlHandlerItem); virtual; function GetOwner: TPersistent; override; public constructor Create(Distributor: TXmlDistributor); function Add: TXmlHandlerItem; procedure Assign(Source: TPersistent); override; function FindHandlerItem(AHandler: TXmlCustomHandler): TXmlHandlerItem; property Distributor: TXmlDistributor read FDistributor; property Items[Index: Integer]: TXmlHandlerItem read GetItem write SetItem; default; end; TXmlDistributor = class(TXmlCustomHandler) private procedure readData(Reader: TReader); procedure writeData(Writer: TWriter); protected FNextHandlers: TXmlHandlers; procedure DefineProperties(Filer: TFiler); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure setNextHandlers(const value: TXmlHandlers); public constructor create(AOwner: TComponent); override; destructor destroy; override; function CDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function charRef(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function comment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function doctype(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId, data: wideString): boolean; override; function endDocument(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString): boolean; override; function endPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix: wideString): boolean; override; function entityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function PCDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function processingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; override; function skippedEntity(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startDocument(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString; sdDl: TdomStandalone): boolean; override; function startElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString; attributes: TdomNameValueList): boolean; override; function startPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix, uri: wideString): boolean; override; function attributeDefinition(const sender: TXmlCustomReader; const locator: TdomLocator; aname, attType, bracket, defaultDecl, attValue: wideString): boolean; override; function conditionalSection(const sender: TXmlCustomReader; const locator: TdomLocator; includeStmt, data: wideString): boolean; override; function DTDcomment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function DTDprocessingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; override; function elementTypeDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, data: wideString): boolean; override; function endAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function entityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId, notaName: wideString): boolean; override; function notationDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId: wideString): boolean; override; function parameterEntityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId: wideString): boolean; override; function parameterEntityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator; version, encDl: wideString): boolean; override; function startIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function resolvePE( PEReferenceName: wideString; var PEValue: wideString; var error: TXmlErrorType): boolean; override; procedure notifyReset; override; published property NextHandlers: TXmlHandlers read FNextHandlers write setNextHandlers; end; TXmlCustomDTDHandler = class(TXmlStandardHandler) public function CDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function charRef(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function comment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function doctype(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId, data: wideString): boolean; override; function endDocument(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString): boolean; override; function endPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix: wideString): boolean; override; function entityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function PCDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function processingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; override; function skippedEntity(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startDocument(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString; sdDl: TdomStandalone): boolean; override; function startElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString; attributes: TdomNameValueList): boolean; override; function startPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix, uri: wideString): boolean; override; end; TXmlCustomContentHandler = class(TXmlStandardHandler) public function attributeDefinition(const sender: TXmlCustomReader; const locator: TdomLocator; aname, attType, bracket, defaultDecl, attValue: wideString): boolean; override; function conditionalSection(const sender: TXmlCustomReader; const locator: TdomLocator; includeStmt, data: wideString): boolean; override; function DTDcomment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function DTDprocessingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; override; function elementTypeDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, data: wideString): boolean; override; function endAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function entityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId, notaName: wideString): boolean; override; function notationDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId: wideString): boolean; override; function parameterEntityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId: wideString): boolean; override; function parameterEntityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator; version, encDl: wideString): boolean; override; function startIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; end; TXmlCustomReader = class(TComponent) private FDOMImpl: TDomImplementation; FNextHandler: TXmlStandardHandler; procedure setDomImpl(const impl: TDomImplementation); protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; function sendErrorNotification(const xmlErrorType: TXmlErrorType; const location: TdomLocator; const code: wideString): boolean; virtual; public constructor create(AOwner: TComponent); override; published property DOMImpl: TDomImplementation read FDomImpl write setDomImpl; property NextHandler: TXmlStandardHandler read FNextHandler write FNextHandler; end; TXmlWFTestContentHandler = class(TXmlCustomContentHandler) protected FIsActive: boolean; FDoctypeFound: boolean; FRootFound: boolean; FTestRootFound: boolean; FTagStack: TdomWideStringList; public constructor create(AOwner: TComponent); override; destructor destroy; override; function CDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function charRef(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function comment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function doctype(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId, data: wideString): boolean; override; function endDocument(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString): boolean; override; function endPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix: wideString): boolean; override; function entityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function PCDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function processingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; override; function skippedEntity(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startDocument(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString; sdDl: TdomStandalone): boolean; override; function startElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString; attributes: TdomNameValueList): boolean; override; function startPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix, uri: wideString): boolean; override; procedure notifyReset; override; property isActive: boolean read FIsActive; property testRootFound: boolean read FTestRootFound write FTestRootFound default true; end; TXmlWFTestDTDHandler = class(TXmlCustomDtdHandler) protected FAttListDeclActive: boolean; FExtDtdIsActive: boolean; FIntDtdIsActive: boolean; public constructor create(AOwner: TComponent); override; destructor destroy; override; function attributeDefinition(const sender: TXmlCustomReader; const locator: TdomLocator; aname, attType, bracket, defaultDecl, attValue: wideString): boolean; override; function conditionalSection(const sender: TXmlCustomReader; const locator: TdomLocator; includeStmt, data: wideString): boolean; override; function DTDcomment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function DTDprocessingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; override; function elementTypeDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, data: wideString): boolean; override; function endAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function entityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId, notaName: wideString): boolean; override; function notationDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId: wideString): boolean; override; function parameterEntityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId: wideString): boolean; override; function parameterEntityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString): boolean; override; function startIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; procedure notifyReset; override; property extDtdIsActive: boolean read FExtDtdIsActive; property intDtdIsActive: boolean read FIntDtdIsActive; end; TXmlDocBuilder = class(TXmlCustomContentHandler) private FBuildNamespaceTree: boolean; protected FRefNode: TdomNode; FPrefixUriList: TdomNameValueList; public constructor create(AOwner: TComponent); override; destructor destroy; override; function CDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function charRef(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function comment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function doctype(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId, data: wideString): boolean; override; function endDocument(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString): boolean; override; function endPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix: wideString): boolean; override; function entityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function PCDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function processingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; override; function skippedEntity(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startDocument(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString; sdDl: TdomStandalone): boolean; override; function startElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString; attributes: TdomNameValueList): boolean; override; function startPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix, uri: wideString): boolean; override; procedure notifyReset; override; property referenceNode: TdomNode read FRefNode write FRefNode; published property BuildNamespaceTree: boolean read FBuildNamespaceTree write FBuildNamespaceTree default false; end; TXmlDtdBuilder = class(TXmlCustomContentHandler) protected FExtDtdIsActive: boolean; FIntDtdIsActive: boolean; FReferenceExtCM: TdomCMExternalObject; FReferenceIntCM: TdomCMInternalObject; FRefNode: TdomCMNode; procedure resolveCharRefsAndPERefs(const s: wideString; var result: wideString; var error: boolean); virtual; procedure insertMixedContent(const sender: TXmlCustomReader; const refNode: TdomCMNode; const contSpec: wideString); virtual; procedure insertChildrenContent(const sender: TXmlCustomReader; const refNode: TdomCMNode; const contSpec: wideString); virtual; procedure insertNotationOrEnumerationContent(const sender: TXmlCustomReader; const refCMAttrDefinition: TdomCMAttrDefinition; const contSpec: wideString); virtual; function getExtContentModel: TdomCMExternalObject; virtual; function getIntContentModel: TdomCMInternalObject; virtual; procedure setExtContentModel(const cm: TdomCMExternalObject); virtual; procedure setIntContentModel(const cm: TdomCMInternalObject); virtual; public constructor create(AOwner: TComponent); override; function attributeDefinition(const sender: TXmlCustomReader; const locator: TdomLocator; aname, attType, bracket, defaultDecl, attValue: wideString): boolean; override; function conditionalSection(const sender: TXmlCustomReader; const locator: TdomLocator; includeStmt, data: wideString): boolean; override; function DTDcomment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function DTDprocessingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; override; function elementTypeDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, data: wideString): boolean; override; function endAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function entityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId, notaName: wideString): boolean; override; function notationDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId: wideString): boolean; override; function parameterEntityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId: wideString): boolean; override; function parameterEntityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString): boolean; override; function startIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function resolvePE( PEReferenceName: wideString; var PEValue: wideString; var error: TXmlErrorType): boolean; override; procedure notifyReset; override; property extContentModel: TdomCMExternalObject read getExtContentModel write setExtContentModel; property extDtdIsActive: boolean read FExtDtdIsActive; property intContentModel: TdomCMInternalObject read getIntContentModel write setIntContentModel; property intDtdIsActive: boolean read FIntDtdIsActive; end; TXmlCMBuilder = class(TXmlCustomContentHandler) protected FContentModel: TdomCMObject; FCurrentAttListName: wideString; FIsActive: boolean; procedure CDataNormalization(const s: wideString; var result: wideString; var error: boolean); virtual; function getContentModel: TdomCMObject; virtual; procedure insertMixedContent(const sender: TXmlCustomReader; const refNode: TdomCMNode; const contSpec: wideString); virtual; procedure insertChildrenContent(const sender: TXmlCustomReader; const refNode: TdomCMNode; const contSpec: wideString); virtual; procedure insertNotationOrEnumerationContent(const sender: TXmlCustomReader; const refCMAttribute: TdomCMAttribute; const contSpec: wideString); virtual; procedure resolveCharRefsAndPERefs(const s: wideString; var result: wideString; var error: boolean); virtual; procedure setContentModel(const cm: TdomCMObject); virtual; public constructor create(AOwner: TComponent); override; function attributeDefinition(const sender: TXmlCustomReader; const locator: TdomLocator; aname, attType, bracket, defaultDecl, attValue: wideString): boolean; override; function conditionalSection(const sender: TXmlCustomReader; const locator: TdomLocator; includeStmt, data: wideString): boolean; override; function DTDcomment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function DTDprocessingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; override; function elementTypeDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, data: wideString): boolean; override; function endAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function entityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, literalValue, pubId, sysId, notaName: wideString): boolean; override; function notationDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId: wideString): boolean; override; function parameterEntityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString): boolean; override; function startIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function resolvePE( PEReferenceName: wideString; var PEValue: wideString; var error: TXmlErrorType): boolean; override; procedure notifyReset; override; property contentModel: TdomCMObject read getContentModel write setContentModel; property isActive: boolean read FIsActive; end; TXmlStreamBuilder = class(TXmlStandardHandler) private FCurrentEncodingType: TdomEncodingType; FDefaultEncoding: wideString; FDefaultEncodingType: TdomEncodingType; FDestination: TStream; FNewLine: TdomNewLineType; procedure setDefaultEncoding(const value: wideString); procedure setDestination(const value: TStream); procedure setNewLine(const value: TdomNewLineType); protected function writeWideString(const sender: TXmlCustomReader; const locator: TdomLocator; const xmlStrg: wideString): boolean; virtual; function writeWideStrings(const sender: TXmlCustomReader; const locator: TdomLocator; const xmlStrgs: array of wideString): boolean; virtual; public constructor create(aOwner: TComponent); override; function CDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function charRef(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function comment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function doctype(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId, data: wideString): boolean; override; function endDocument(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString): boolean; override; function endPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix: wideString): boolean; override; function entityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function PCDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function processingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; override; function skippedEntity(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startDocument(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString; sdDl: TdomStandalone): boolean; override; function startElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString; attributes: TdomNameValueList): boolean; override; function startPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix, uri: wideString): boolean; override; function attributeDefinition(const sender: TXmlCustomReader; const locator: TdomLocator; aname, attType, bracket, defaultDecl, attValue: wideString): boolean; override; function conditionalSection(const sender: TXmlCustomReader; const locator: TdomLocator; includeStmt, data: wideString): boolean; override; function DTDcomment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; override; function DTDprocessingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; override; function elementTypeDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, data: wideString): boolean; override; function endAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function endIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function entityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId, notaName: wideString): boolean; override; function notationDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId: wideString): boolean; override; function parameterEntityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId: wideString): boolean; override; function parameterEntityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; override; function startExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString): boolean; override; function startIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; override; function resolvePE( PEReferenceName: wideString; var PEValue: wideString; var error: TXmlErrorType): boolean; override; procedure notifyReset; override; property currentEncodingType: TdomEncodingType read FCurrentEncodingType; property defaultEncoding: wideString read FDefaultEncoding write SetDefaultEncoding; property defaultEncodingType: TdomEncodingType read FDefaultEncodingType; property destination: TStream read FDestination write setDestination; published property newLine: TdomNewLineType read FNewLine write setNewLine default nltCRLF; end; TXmlStandardDocReader = class (TXmlCustomReader) protected FPrefixMapping: boolean; FPrefixMappingStack: TList; FSuppressXmlns: boolean; function analyzeElement(const locator: TdomLocator; const source: wideString; out tagName: wideString; const attributes: TdomNameValueList): boolean; virtual; procedure clearPrefixMappingStack; virtual; function writeProcessingInstruction(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeComment(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeCDATA(const locator: TdomLocator; const content: wideString): boolean; virtual; function writePCDATA(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeStartDocument(const locator: TdomLocator; version, encName: wideString; sdDl: TdomStandalone): boolean; virtual; function writeStartElement(const locator: TdomLocator; const content: wideString; out tagName: wideString): boolean; virtual; function writeStartPrefixMapping(const locator: TdomLocator; prefix, uri: wideString): boolean; virtual; function writeEndDocument(const locator: TdomLocator): boolean; virtual; function writeEndElement(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeEndPrefixMapping(const locator: TdomLocator; prefix: wideString): boolean; virtual; function writeEmptyElement(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeCharRef(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeEntityRef(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeDoctype(const locator: TdomLocator; const content: wideString): boolean; virtual; public constructor create(AOwner: TComponent); override; destructor destroy; override; function parse(const inputSource: TXmlInputSource):boolean; virtual; published property PrefixMapping: boolean read FPrefixMapping write FPrefixMapping; property SuppressXmlns: boolean read FSuppressXmlns write FSuppressXmlns; end; TXmlStandardDtdReader = class (TXmlCustomReader) private function findNextAttDef(const Decl: wideString; var aname, attType, Bracket, defaultDecl, attValue, Rest: wideString): boolean; protected function includeAsPE(const inputSource: TXmlInputSource; var s: wideString): boolean; virtual; function includeInLiteral(const inputSource: TXmlInputSource; var s: wideString): boolean; virtual; function writeConditionalSection(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeDTDProcessingInstruction(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeDTDComment(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeParameterEntityRef(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeEntityDeclaration(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeElementDeclaration(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeAttributeDeclaration(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeNotationDeclaration(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeStartExtDtd(const locator: TdomLocator; version, encName: wideString): boolean; virtual; function writeStartIntDtd(const locator: TdomLocator): boolean; virtual; public function parseExternalSubset(const inputSource: TXmlInputSource):boolean; virtual; function parseInternalSubset(const inputSource: TXmlInputSource):boolean; virtual; end; TXmlCustomDomReader = class (TXmlCustomReader) protected FPrefixMapping: boolean; FSuppressXmlns: boolean; function parseloop(const sourceNode: TdomNode): boolean; virtual; function writeCDATA(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeCharRef(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeComment(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeDoctype(const locator: TdomLocator; const aname, publicId, systemId, intSubset: wideString): boolean; virtual; function writeEmptyElement(const locator: TdomLocator; const tagName: wideString; const attributeList: TdomNameValueList): boolean; virtual; function writeEndDocument(const locator: TdomLocator): boolean; virtual; function writeEndElement(const locator: TdomLocator; const tagName: wideString): boolean; virtual; function writeEndPrefixMapping(const locator: TdomLocator; prefix: wideString): boolean; virtual; function writeEntityRef(const locator: TdomLocator; const entityName: wideString): boolean; virtual; function writePCDATA(const locator: TdomLocator; const content: wideString): boolean; virtual; function writeProcessingInstruction(const locator: TdomLocator; const targ, attribSequence : wideString): boolean; virtual; function writeStartDocument(const locator: TdomLocator; version, encName: wideString; sdDl: TdomStandalone): boolean; virtual; function writeStartElement(const locator: TdomLocator; const tagName: wideString; const attributeList: TdomNameValueList): boolean; virtual; function writeStartPrefixMapping(const locator: TdomLocator; prefix, uri: wideString): boolean; virtual; property PrefixMapping: boolean read FPrefixMapping write FPrefixMapping; property SuppressXmlns: boolean read FSuppressXmlns write FSuppressXmlns; public constructor create(AOwner: TComponent); override; end; TXmlStandardDomReader = class (TXmlCustomDomReader) public function parse(const sourceNode: TdomNode): boolean; virtual; published property PrefixMapping; property SuppressXmlns; end; TXmlStandardCMReader = class (TXmlCustomReader) protected function writeAttributeDefinition(const locator: TdomLocator; aname, attType, bracket, defaultDecl, attValue: wideString): boolean; virtual; function writeDTDComment(const locator: TdomLocator; content: wideString): boolean; virtual; function writeDTDProcessingInstruction(const locator: TdomLocator; targ, attribSequence : wideString): boolean; virtual; function writeElementTypeDeclaration(const locator: TdomLocator; aname, data: wideString): boolean; virtual; function writeEndAttListDeclaration(const locator: TdomLocator): boolean; virtual; function writeEndExtDtd(const locator: TdomLocator): boolean; virtual; function writeEndIntDtd(const locator: TdomLocator): boolean; virtual; function writeEntityDeclaration(const locator: TdomLocator; aname, entityValue, pubId, sysId, notaName: wideString): boolean; virtual; function writeNotationDeclaration(const locator: TdomLocator; aname, pubId, sysId: wideString): boolean; virtual; function writeParameterEntityRef(const locator: TdomLocator; content: wideString): boolean; virtual; function writeStartAttListDeclaration(const locator: TdomLocator; aname: wideString): boolean; virtual; function writeStartExtDtd(const locator: TdomLocator; version, encName: wideString): boolean; virtual; function writeStartIntDtd(const locator: TdomLocator): boolean; virtual; function parseloop(const sourceCMNode: TdomCMNode): boolean; virtual; public function parse(const sourceCMNode: TdomCMNode): boolean; virtual; end; TXmlCustomParser = class (TComponent) private FDOMImpl: TDomImplementation; protected procedure setDomImpl(const impl: TDomImplementation); virtual; procedure Notification(AComponent: TComponent; Operation: TOperation); override; published constructor create(aOwner: TComponent); override; property DOMImpl: TDomImplementation read FDOMImpl write setDomImpl; end; TXmlCMAnalyzer = class (TXmlCustomParser) protected FCMReader: TXmlStandardCMReader; FCMBuilder: TXmlCMBuilder; // xxx will be replaced by TXmlASBuilder in the future. FDtdReader: TXmlStandardDtdReader; procedure setDomImpl(const impl: TDomImplementation); override; public constructor create(aOwner: TComponent); override; destructor destroy; override; function analyzeCM(const source: TdomCustomCMIEObject; const target: TdomCMObject): boolean; virtual; procedure analyzeIntDTDStr( str: wideString; const target: TdomCMObject); virtual; end; TXmlToDomParser = class (TXmlCustomParser) protected FDtdBuilder: TXmlDtdBuilder; FDtdReader: TXmlStandardDtdReader; FDocBuilder: TXmlDocBuilder; FDocReader: TXmlStandardDocReader; FTabWidth: integer; FWFTestContentHandler: TXmlWFTestContentHandler; FWFTestDtdHandler: TXmlWFTestDtdHandler; procedure doExternalSubset(const parentSystemId: wideString; var publicId, systemId: wideString; var stream: TStream; var action: TXmlParserAction); virtual; function processDocFile(const pubId, sysId: wideString): boolean; virtual; function processDocSourceCode(const intDtdSourceCode: TXmlSourceCode; const pubId, sysId: wideString): boolean; virtual; function processDocStream(const stream: TStream; const pubId, sysId: wideString): boolean; virtual; function processDocString(const str: String; const pubId, sysId: wideString): boolean; virtual; function processDocWideString(str: wideString; const pubId, sysId: wideString): boolean; virtual; function processDtd(const doc: TdomDocument): boolean; virtual; function processExtDtdFile(const pubId, sysId: wideString): boolean; virtual; function processExtDtdSourceCode(const intDtdSourceCode: TXmlSourceCode; const pubId, sysId: wideString): boolean; virtual; function processExtDtdStream(const stream: TStream; const pubId, sysId: wideString): boolean; virtual; function processExtDtdString(const str: String; const pubId, sysId: wideString): boolean; virtual; function processExtDtdWideString(str: wideString; const pubId, sysId: wideString): boolean; virtual; function processIntDtdFile(const pubId, sysId: wideString): boolean; virtual; function processIntDtdSourceCode(const intDtdSourceCode: TXmlSourceCode; const pubId, sysId: wideString): boolean; virtual; function processIntDtdStream(const stream: TStream; const pubId, sysId: wideString): boolean; virtual; function processIntDtdString(const str: String; const pubId, sysId: wideString): boolean; virtual; function processIntDtdWideString(str: wideString; const pubId, sysId: wideString): boolean; virtual; function sendErrorNotification(const xmlErrorType: TXmlErrorType): boolean; virtual; procedure setDomImpl(const impl: TDomImplementation); override; procedure setTabWidth(const value: integer); virtual; public constructor create(aOwner: TComponent); override; procedure docSourceCodeToDom(const docSourceCode: TXmlSourceCode; const pubId, sysId: wideString; const refNode: TdomNode); virtual; procedure docStreamToDom(const stream: TStream; const pubId, sysId: wideString; const refNode: TdomNode); virtual; procedure docStringToDom(const Str: string; const pubId, sysId: wideString; const refNode: TdomNode); virtual; procedure docWideStringToDom( str: wideString; const pubId, sysId: wideString; const refNode: TdomNode); virtual; procedure extDtdSourceCodeToDom(const ExtDtdSourceCode: TXmlSourceCode; const pubId, sysId: wideString; const refNode: TdomCMNode); virtual; procedure extDtdStreamToDom(const stream: TStream; const pubId, sysId: wideString; const refNode: TdomCMNode); virtual; procedure extDtdStringToDom(const str: string; const pubId, sysId: wideString; const refNode: TdomCMNode); virtual; procedure extDtdWideStringToDom( str: wideString; const pubId, sysId: wideString; const refNode: TdomCMNode); virtual; procedure intDtdSourceCodeToDom(const IntDtdSourceCode: TXmlSourceCode; const pubId, sysId: wideString; const refNode: TdomCMNode); virtual; procedure intDtdStreamToDom(const stream: TStream; const pubId, sysId: wideString; const refNode: TdomCMNode); virtual; procedure intDtdStringToDom(const str: string; const pubId, sysId: wideString; const refNode: TdomCMNode); virtual; procedure intDtdWideStringToDom( str: wideString; const pubId, sysId: wideString; const refNode: TdomCMNode); virtual; function fileToDom(const filename: TFileName): TdomDocument; virtual; function sourceCodeToDom(const sc: TXmlSourceCode): TdomDocument; virtual; function streamToDom(const stream: TStream): TdomDocument; virtual; function stringToDom(const str: String): TdomDocument; virtual; function wideStringToDom(str: wideString): TdomDocument; virtual; published property TabWidth: integer read FTabWidth write setTabWidth default 1; end; TDomToXmlParser = class (TXmlCustomParser) protected FStreamBuilder: TXmlStreamBuilder; FDomReader: TXmlStandardDomReader; function getNewLine: TdomNewLineType; virtual; procedure setNewLine(const value: TdomNewLineType); virtual; public constructor create(aOwner: TComponent); override; function writeToStream(const wnode: TdomNode; const encoding: wideString; const destination: TStream): boolean; virtual; function writeToString(const wnode: TdomNode; const encoding: wideString; out S: string): boolean; virtual; function writeToWideString(const wnode: TdomNode; out S: wideString): boolean; virtual; published property newLine: TdomNewLineType read getNewLine write setNewLine; end; TCMToXmlParser = class (TXmlCustomParser) protected FStreamBuilder: TXmlStreamBuilder; FCMReader: TXmlStandardCMReader; function getNewLine: TdomNewLineType; virtual; procedure setNewLine(const value: TdomNewLineType); virtual; public constructor create(aOwner: TComponent); override; function writeToStream(const wnode: TdomCMNode; const encoding: wideString; const destination: TStream): boolean; virtual; function writeToString(const wnode: TdomCMNode; const encoding: wideString; out S: string): boolean; virtual; function writeToWideString(const wnode: TdomCMNode; out S: wideString): boolean; virtual; published property newLine: TdomNewLineType read getNewLine write setNewLine; end; {DOM XPath} TdomXPathTokenType = ( XPATH_LEFT_PARENTHESIS_TOKEN, XPATH_RIGHT_PARENTHESIS_TOKEN, XPATH_LEFT_SQUARE_BRACKET_TOKEN, XPATH_RIGHT_SQUARE_BRACKET_TOKEN, XPATH_SINGLE_DOT_TOKEN, XPATH_DOUBLE_DOT_TOKEN, XPATH_COMMERCIAL_AT_TOKEN, XPATH_COMMA_TOKEN, XPATH_DOUBLE_COLON_TOKEN, XPATH_NAME_TEST_TOKEN, XPATH_NODE_TYPE_COMMENT_TOKEN, XPATH_NODE_TYPE_TEXT_TOKEN, XPATH_NODE_TYPE_PI_TOKEN, XPATH_NODE_TYPE_NODE_TOKEN, XPATH_AND_OPERATOR_TOKEN, XPATH_OR_OPERATOR_TOKEN, XPATH_MOD_OPERATOR_TOKEN, XPATH_DIV_OPERATOR_TOKEN, XPATH_MULTIPLY_OPERATOR_TOKEN, XPATH_SLASH_OPERATOR_TOKEN, XPATH_SHEFFER_STROKE_OPERATOR_TOKEN, XPATH_PLUS_OPERATOR_TOKEN, XPATH_MINUS_OPERATOR_TOKEN, XPATH_IS_EQUAL_OPERATOR_TOKEN, XPATH_IS_NOT_EQUAL_OPERATOR_TOKEN, XPATH_LESS_THAN_OPERATOR_TOKEN, XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN, XPATH_GREATER_THAN_OPERATOR_TOKEN, XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN, XPATH_FUNCTION_NAME_TOKEN, XPATH_AXIS_NAME_ANCESTOR_TOKEN, XPATH_AXIS_NAME_ANCESTOR_OR_SELF_TOKEN, XPATH_AXIS_NAME_ATTRIBUTE_TOKEN, XPATH_AXIS_NAME_CHILD_TOKEN, XPATH_AXIS_NAME_DESCENDANT_TOKEN, XPATH_AXIS_NAME_DESCENDANT_OR_SELF_TOKEN, XPATH_AXIS_NAME_FOLLOWING_TOKEN, XPATH_AXIS_NAME_FOLLOWING_SIBLING_TOKEN, XPATH_AXIS_NAME_NAMESPACE_TOKEN, XPATH_AXIS_NAME_PARENT_TOKEN, XPATH_AXIS_NAME_PRECEDING_TOKEN, XPATH_AXIS_NAME_PRECEDING_SIBLING_TOKEN, XPATH_AXIS_NAME_SELF_TOKEN, XPATH_LITERAL_TOKEN, XPATH_NUMBER_TOKEN, XPATH_VARIABLE_REFERENCE_TOKEN, XPATH_END_OF_TEXT_TOKEN, XPATH_INVALID_TOKEN ); TdomXPathAxisType = ( XPATH_FORWARD_AXIS, XPATH_REVERSE_AXIS ); TdomXPathSyntaxNode = class; TdomXPathSyntaxNodeStack = class private FNodeList: TList; protected function getLength: integer; virtual; public constructor create; virtual; destructor destroy; override; procedure clear; virtual; function peek(offset: integer): TdomXPathSyntaxNode; virtual; function pop: TdomXPathSyntaxNode; virtual; function push(node: TdomXPathSyntaxNode): TdomXPathSyntaxNode; virtual; property length: integer read getLength; end; TdomXPathSyntaxNode = class protected FLeft: TdomXPathSyntaxNode; FRight: TdomXPathSyntaxNode; FValue: wideString; public constructor create(const value: wideString); virtual; destructor destroy; override; function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; virtual; property left: TdomXPathSyntaxNode read FLeft write FLeft; property right: TdomXPathSyntaxNode read FRight write FRight; property value: wideString read FValue; end; // Cf. XPath 1.0, prod. [2]. TdomXPathAbsoluteLocationPath = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [4]. TdomXPathStep = class(TdomXPathSyntaxNode) public function addStep(const step: TdomXPathStep): boolean; virtual; function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; function evaluate2(const oldSnapshotResult: TdomXPathSnapshotResult; const resolver: TdomXPathNSResolver): TdomXPathSnapshotResult; virtual; end; // Cf. XPath 1.0, prod. [6]. // This class is only used as a common ancestor of the axis name classes below. TdomXPathCustomAxisName = class(TdomXPathSyntaxNode) protected FAxisType: TdomXPathAxisType; FPrincipalNodeType: TdomNodeType; function getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; virtual; abstract; public constructor create(const avalue: wideString); override; function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; function evaluate2(const oldSnapshotResult: TdomXPathSnapshotResult; const resolver: TdomXPathNSResolver): TdomXPathSnapshotResult; virtual; property axisType: TdomXPathAxisType read FAxisType; end; // Cf. XPath 1.0, prod. [6]. TdomXPathAxisNameAncestor = class(TdomXPathCustomAxisName) protected function getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; override; public constructor create(const avalue: wideString); override; end; // Cf. XPath 1.0, prod. [6]. TdomXPathAxisNameAncestorOrSelf = class(TdomXPathCustomAxisName) protected function getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; override; public constructor create(const avalue: wideString); override; end; // Cf. XPath 1.0, prod. [6]. TdomXPathAxisNameAttribute = class(TdomXPathCustomAxisName) protected function getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; override; public constructor create(const avalue: wideString); override; end; // Cf. XPath 1.0, prod. [6]. TdomXPathAxisNameChild = class(TdomXPathCustomAxisName) protected function getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; override; end; // Cf. XPath 1.0, prod. [6]. TdomXPathAxisNameDescendant = class(TdomXPathCustomAxisName) protected function getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; override; end; // Cf. XPath 1.0, prod. [6]. TdomXPathAxisNameDescendantOrSelf = class(TdomXPathCustomAxisName) protected function getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; override; end; // Cf. XPath 1.0, prod. [6]. TdomXPathAxisNameFollowing = class(TdomXPathCustomAxisName) protected function getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; override; end; // Cf. XPath 1.0, prod. [6]. TdomXPathAxisNameFollowingSibling = class(TdomXPathCustomAxisName) protected function getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; override; end; // Cf. XPath 1.0, prod. [6]. TdomXPathAxisNameNamespace = class(TdomXPathCustomAxisName) protected function getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; override; public constructor create(const avalue: wideString); override; end; // Cf. XPath 1.0, prod. [6]. TdomXPathAxisNameParent = class(TdomXPathCustomAxisName) protected function getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; override; end; // Cf. XPath 1.0, prod. [6]. TdomXPathAxisNamePreceding = class(TdomXPathCustomAxisName) protected function getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; override; public constructor create(const avalue: wideString); override; end; // Cf. XPath 1.0, prod. [6]. TdomXPathAxisNamePrecedingSibling = class(TdomXPathCustomAxisName) protected function getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; override; public constructor create(const avalue: wideString); override; end; // Cf. XPath 1.0, prod. [6]. TdomXPathAxisNameSelf = class(TdomXPathCustomAxisName) protected function getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; override; end; // Cf. XPath 1.0, prod. [7]. TdomXPathNodeTest = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; function evaluate2(const oldsnapshotResult: TdomXPathSnapshotResult; const principalNodeType: TdomNodeType; const resolver: TdomXPathNSResolver): TdomXPathSnapshotResult; virtual; end; // Cf. XPath 1.0, prod. [8]. TdomXPathPredicate = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; function evaluate2(const oldSnapshotResult: TdomXPathSnapshotResult; const resolver: TdomXPathNSResolver): TdomXPathSnapshotResult; virtual; end; // Cf. XPath 1.0, prod. [14]. TdomXPathExpr = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [15]. TdomXPathPrimaryExpr = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [16]. TdomXPathFunctionCall = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [17]. TdomXPathArgument = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [18]. TdomXPathUnionExpr = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [19]. TdomXPathPathExpr = class(TdomXPathSyntaxNode) public function addStep(const step: TdomXPathStep): boolean; virtual; function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [20]. TdomXPathFilterExpr = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [21]. TdomXPathOrExpr = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [22]. TdomXPathAndExpr = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [23]. TdomXPathIsEqualExpr = class(TdomXPathSyntaxNode) function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [23]. TdomXPathIsNotEqualExpr = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [24]. TdomXPathLessThanExpr = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [24]. TdomXPathLessThanOrEqualExpr = class(TdomXPathSyntaxNode) function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [24]. TdomXPathGreaterThanExpr = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [24]. TdomXPathGreaterThanOrEqualExpr = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [25]. TdomXPathPlusExpr = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [25]. TdomXPathMinusExpr = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [26]. TdomXPathMultiplyExpr = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [26]. TdomXPathDivExpr = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [26]. TdomXPathModExpr = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [27]. TdomXPathUnaryExpr = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [28]. TdomXPathLeftParenthesis = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [28]. TdomXPathRightParenthesis = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [28]. TdomXPathLeftSquareBracket = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [28]. TdomXPathRightSquareBracket = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [28]. TdomXPathSingleDot = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [28]. TdomXPathDoubleDot = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [28]. TdomXPathCommercialAt = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [28]. TdomXPathComma = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [28]. TdomXPathDoubleColon = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [29]. TdomXPathLiteral = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [30]. TdomXPathNumber = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [32]. TdomXPathSlashOperator = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [32]. TdomXPathShefferStrokeOperator = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [32]. TdomXPathPlusOperator = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [32]. TdomXPathMinusOperator = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [32]. TdomXPathIsEqualOperator = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [32]. TdomXPathIsNotEqualOperator = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [32]. TdomXPathLessThanOperator = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [32]. TdomXPathLessThanOrEqualOperator = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [32]. TdomXPathGreaterThanOperator = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [32]. TdomXPathGreaterThanOrEqualOperator = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [33]. TdomXPathAndOperator = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [33]. TdomXPathOrOperator = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [33]. TdomXPathModOperator = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [33]. TdomXPathDivOperator = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [34]. TdomXPathMultiplyOperator = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [35]. TdomXPathFunctionName = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [36]. TdomXPathVariableReference = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; end; // Cf. XPath 1.0, prod. [37]. TdomXPathNameTest = class(TdomXPathSyntaxNode) protected FPrefix: wideString; FLocalName: wideString; public constructor create(const avalue: wideString); override; function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; function evaluate2(const oldSnapshotResult: TdomXPathSnapshotResult; const principalNodeType: TdomNodeType; const resolver: TdomXPathNSResolver): TdomXPathSnapshotResult; virtual; end; // Cf. XPath 1.0, prod. [38]. TdomXPathNodeTypeComment = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; function evaluate2(const oldSnapshotResult: TdomXPathSnapshotResult): TdomXPathSnapshotResult; virtual; end; // Cf. XPath 1.0, prod. [38]. TdomXPathNodeTypeNode = class(TdomXPathSyntaxNode) end; // Cf. XPath 1.0, prod. [38]. TdomXPathNodeTypePI = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; function evaluate2(const oldSnapshotResult: TdomXPathSnapshotResult): TdomXPathSnapshotResult; virtual; end; // Cf. XPath 1.0, prod. [38]. TdomXPathNodeTypeText = class(TdomXPathSyntaxNode) public function evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; override; function evaluate2(const oldSnapshotResult: TdomXPathSnapshotResult): TdomXPathSnapshotResult; virtual; end; TdomXPathSlashStatus = ( SL_NO_DOUBLE_SLASH, SL_XPATH_AXIS_NAME_DESCENDANT_OR_SELF_TOKEN_FOLLOWS, SL_XPATH_DOUBLE_COLON_TOKEN_FOLLOWS, SL_XPATH_NODE_TYPE_NODE_TOKEN_FOLLOWS, SL_XPATH_LEFT_PARENTHESIS_FOLLOWS, SL_XPATH_RIGHT_PARENTHESIS_FOLLOWS, SL_XPATH_SLASH_OPERATOR_TOKEN_FOLLLOWS ); TdomXPathTokenizer = class protected FCacheIsActive: boolean; FDoubleSlashStatus: TdomXPathSlashStatus; FExpression: wideString; FLastSymbol: TdomXPathTokenType; FPosition: integer; FPositionCache: integer; FSymbolCache: TdomXPathTokenType; FValueCache: wideString; function doubleColonFollows: boolean; virtual; function getNextWideChar(out s: wideChar): boolean; virtual; function leftParanthesisFollows: boolean; virtual; function lookAheadNextWideChar(out s: wideChar): boolean; virtual; public constructor create(const expression: wideString; const xpathVersion: wideString); virtual; function isFollowing(const symbol: TdomXPathTokenType): boolean; virtual; procedure read(out symbol: TdomXPathTokenType; out value: wideString; out position: integer); virtual; procedure reset; virtual; end; TdomXPathExpression = class protected FIsPrepared: boolean; // Indicates whether the syntax tree has already been build. FIsValid: boolean; // Indicates whether there was a syntax error found during preparation. FExpression: wideString; // Holds the expression to be evaluated. FOwnerDocument: TdomDocument; // The Document that created this XPath Expression. FResolver: TdomXPathNSResolver; // Points to the namespace resolver to be used. FSyntaxTree: TdomXPathExpr; // Holds the root node of the XPath syntax tree if the expression was valid. function createSyntaxNode(const symbol: TdomXPathTokenType; const value: wideString): TdomXPathSyntaxNode; virtual; public constructor create(const aOwner: TdomDocument; const expression: wideString; const resolver: TdomXPathNSResolver); virtual; function evaluate(const contextNode: TdomNode; const typeCodes: TdomXPathResultTypes; const oldResult: TdomXPathResult): TdomXPathResult; virtual; function prepare: boolean; virtual; end; TdomXPathNSResolver = class protected FPrefixUriList: TdomNameValueList; public constructor create(const resolverNode: TdomNode); virtual; destructor destroy; override; function lookupNamespaceURI(const prefix: wideString): wideString; virtual; end; TdomXPathResult = class protected FResultType: TdomXPathResultType; public property resultType: TdomXPathResultType read FResultType; end; TdomXPathSnapshotResult = class(TdomXPathResult) protected FAxisType: TdomXPathAxisType; FList: TList; procedure add(const node: TdomNode); virtual; procedure addSnapshotResult(const ir: TdomXPathSnapshotResult); virtual; procedure addSubtree(const node: TdomNode); virtual; procedure delete(const index: integer); virtual; function getSnapshotLength: integer; virtual; procedure setAxisType(const value: TdomXPathAxisType); virtual; property axisType: TdomXPathAxisType read FAxisType write setAxisType default XPATH_FORWARD_AXIS; public constructor create; virtual; destructor destroy; override; function snapshotItem(const index: integer): TdomNode; virtual; property snapshotLength: integer read getSnapshotLength; end; TdomXPathBooleanResult = class(TdomXPathResult) protected FBooleanValue: boolean; public constructor create(const aBooleanValue: boolean); virtual; property booleanValue: boolean read FBooleanValue; end; TdomXPathNumberResult = class(TdomXPathResult) protected FNumberValue: double; public constructor create(const aNumberValue: double); virtual; property numberValue: double read FNumberValue; end; TdomXPathStringResult = class(TdomXPathResult) protected FStringValue: wideString; public constructor create(const aStringValue: wideString); virtual; property stringValue: wideString read FStringValue; end; // XPathFunctions function XPathBooleanFunc(const oldResult: TdomXPathResult): TdomXPathBooleanResult; function XPathNumberFunc(const oldResult: TdomXPathResult): TdomXPathNumberResult; function XPathStringFunc(const oldResult: TdomXPathResult): TdomXPathStringResult; // WideString Handling Routines function trimWhitespace(S: wideString): wideString; function trimWhitespaceLeft(S: wideString): wideString; function trimWhitespaceRight(S: wideString): wideString; // Routines for XML Namespace Processing function xmlExtractPrefix(const qualifiedName: wideString): wideString; function xmlExtractLocalName(const qualifiedName: wideString): wideString; function xmlExtractPrefixAndLocalName(const qualifiedName: wideString; out prefix, localName: wideString): boolean; // Routines for Testing XML Rules function isXmlChar(const S: WideChar): boolean; function IsXmlWhiteSpace(const S: WideChar): boolean; function isXmlLetter(const S: WideChar): boolean; function isXmlBaseChar(const S: WideChar): boolean; function isXmlIdeographic(const S: WideChar): boolean; function isXmlCombiningChar(const S: WideChar): boolean; function isXmlDigit(const S: WideChar): boolean; function isXmlExtender(const S: WideChar): boolean; function isXmlNameChar(const S: WideChar): boolean; function isXmlPubidChar(const S: WideChar): boolean; function isXmlChars(const S: wideString): boolean; function isXmlS(const S: wideString): boolean; function isXmlName(const S: wideString): boolean; function isXmlNames(const S: wideString): boolean; function isXmlNmtoken(const S: wideString): boolean; function isXmlNmtokens(const S: wideString): boolean; function isXmlCharRef(const S: wideString): boolean; function isXmlEntityRef(const S: wideString): boolean; function isXmlPEReference(const S: wideString): boolean; function isXmlReference(const S: wideString): boolean; function isXmlEntityValue(const S: wideString): boolean; function isXmlEntityValueChars(const S: wideString): boolean; function isXmlAttValue(const S: wideString): boolean; function isXmlSystemLiteral(const S: wideString): boolean; function isXmlSystemChars(const S: wideString): boolean; function isXmlPubidLiteral(const S: wideString): boolean; function isXmlPubidChars(const S: wideString): boolean; function isXmlComment(const S: wideString): boolean; function isXmlCData(const S: wideString): boolean; function isXmlCharData(const S: wideString): boolean; function isXmlPITarget(const S: wideString): boolean; function isXmlVersionNumChar(const S: WideChar): boolean; function isXmlVersionNum(const S: wideString): boolean; function isXmlEncNameLeadingChar(const s: WideChar): boolean; function isXmlEncNameFollowingChar(const s: WideChar): boolean; function isXmlEncName(const S: wideString): boolean; function isXmlStringType(const S: wideString): boolean; function isXmlTokenizedType(const S: wideString): boolean; function isXmlNCNameChar(const s: WideChar): boolean; function isXmlNCName(const S: wideString): boolean; function isXmlDefaultAttName(const S: wideString): boolean; function isXmlPrefixedAttName(const S: wideString): boolean; function isXmlNSAttName(const S: wideString): boolean; function isXmlLocalPart(const S: wideString): boolean; function isXmlPrefix(const S: wideString): boolean; function isXmlQName(const S: wideString): boolean; // Character Encoding Conversion function resolveCharRefs(const S: wideString): wideString; function xmlIntToCharRef(const value: integer): wideString; function xmlCharRefToInt(const S: wideString): integer; function xmlCharRefToStr(const S: wideString): wideString; function xmlStrToCharRef(const S: wideString): wideString; // Augmented Backus-Naur Form (ABNF) Core Rules (cf. RFC 2234, 6.1) function isAbnfALPHAWideChar(c: wideChar): boolean; function isAbnfBITWideChar(c: wideChar): boolean; function isAbnfCHARWideChar(c: wideChar): boolean; function isAbnfCRWideChar(c: wideChar): boolean; function isAbnfCRLFWideStr(s: wideString): boolean; function isAbnfCTLWideChar(c: wideChar): boolean; function isAbnfDIGITWideChar(c: wideChar): boolean; function isAbnfDQUOTEWideChar(c: wideChar): boolean; function isAbnfHEXDIGWideChar(c: wideChar): boolean; function isAbnfHTABWideChar(c: wideChar): boolean; function isAbnfLFWideChar(c: wideChar): boolean; function isAbnfLWSPWideStr(s: wideString): boolean; function isAbnfOCTETWideChar(c: wideChar): boolean; function isAbnfSPWideChar(c: wideChar): boolean; function isAbnfVCHARWideChar(c: wideChar): boolean; function isAbnfWSPWideChar(c: wideChar): boolean; function isAbnfALPHAChar(c: char): boolean; function isAbnfBITChar(c: char): boolean; function isAbnfCHARChar(c: char): boolean; function isAbnfCRChar(c: char): boolean; function isAbnfCRLFStr(s: string): boolean; function isAbnfCTLChar(c: char): boolean; function isAbnfDIGITChar(c: char): boolean; function isAbnfDQUOTEChar(c: char): boolean; function isAbnfHEXDIGChar(c: char): boolean; function isAbnfHTABChar(c: char): boolean; function isAbnfLFChar(c: char): boolean; function isAbnfLWSPStr(s: string): boolean; function isAbnfOCTETChar(c: char): boolean; function isAbnfSPChar(c: char): boolean; function isAbnfVCHARChar(c: char): boolean; function isAbnfWSPChar(c: char): boolean; // URI Rules (cf. RFC 2396, App. A) function isUriURI_referenceWideStr(s: wideString): boolean; function isUriAbsoluteURIWideStr(s: wideString): boolean; function isUriRelativeURIWideStr(s: wideString): boolean; function isUriHier_partWideStr(s: wideString): boolean; function isUriOpaque_partWideStr(s: wideString): boolean; function isUriNet_pathWideStr(s: wideString): boolean; function isUriAbs_pathWideStr(s: wideString): boolean; function isUriRel_pathWideStr(s: wideString): boolean; function isUriRel_segmentWideStr(s: wideString): boolean; function isUriSchemeWideStr(s: wideString): boolean; function isUriAuthorityWideStr(s: wideString): boolean; function isUriReg_nameWideStr(s: wideString): boolean; function isUriServerWideStr(s: wideString): boolean; function isUriUserinfoWideStr(s: wideString): boolean; function isUriHostPortWideStr(s: wideString): boolean; function isUriHostWideStr(s: wideString): boolean; function isUriHostnameWideStr(s: wideString): boolean; function isUriDomainlabelWideStr(s: wideString): boolean; function isUriToplabelWideStr(s: wideString): boolean; function isUriIPv4addressWideStr(s: wideString): boolean; function isUriPortWideStr(s: wideString): boolean; function isUriPathWideStr(s: wideString): boolean; function isUriPath_segmentsWideStr(s: wideString): boolean; function isUriSegmentWideStr(s: wideString): boolean; function isUriParamWideStr(s: wideString): boolean; function isUriQueryWideStr(s: wideString): boolean; function isUriFragmentWideStr(s: wideString): boolean; function isUriUricWideStr(s: wideString): boolean; function isUriReservedWideChar(c: wideChar): boolean; function isUriUnreservedWideChar(c: wideChar): boolean; function isUriMarkWideChar(c: wideChar): boolean; function isUriHexWideChar(c: wideChar): boolean; function isUriAlphanumWideChar(c: wideChar): boolean; function isUriAlphaWideChar(c: wideChar): boolean; function isUriDigitWideChar(c: wideChar): boolean; function isUriURI_referenceStr(s: string): boolean; function isUriAbsoluteURIStr(s: string): boolean; function isUriRelativeURIStr(s: string): boolean; function isUriHier_partStr(s: string): boolean; function isUriOpaque_partStr(s: string): boolean; function isUriNet_pathStr(s: string): boolean; function isUriAbs_pathStr(s: string): boolean; function isUriRel_pathStr(s: string): boolean; function isUriRel_segmentStr(s: string): boolean; function isUriSchemeStr(s: string): boolean; function isUriAuthorityStr(s: string): boolean; function isUriReg_nameStr(s: string): boolean; function isUriServerStr(s: string): boolean; function isUriUserinfoStr(s: string): boolean; function isUriHostPortStr(s: string): boolean; function isUriHostStr(s: string): boolean; function isUriHostnameStr(s: string): boolean; function isUriDomainlabelStr(s: string): boolean; function isUriToplabelStr(s: string): boolean; function isUriIPv4addressStr(s: string): boolean; function isUriPortStr(s: string): boolean; function isUriPathStr(s: string): boolean; function isUriPath_segmentsStr(s: string): boolean; function isUriSegmentStr(s: string): boolean; function isUriParamStr(s: string): boolean; function isUriQueryStr(s: string): boolean; function isUriFragmentStr(s: string): boolean; function isUriUricStr(s: string): boolean; function isUriReservedChar(c: char): boolean; function isUriUnreservedChar(c: char): boolean; function isUriMarkChar(c: char): boolean; function isUriHexChar(c: char): boolean; function isUriAlphanumChar(c: char): boolean; function isUriAlphaChar(c: char): boolean; function isUriDigitChar(c: char): boolean; function filenameToUriStr(const path: TFilename; const opt: TdomFilenameToUriOptions): string; function filenameToUriWideStr(const path: TFilename; const opt: TdomFilenameToUriOptions): wideString; function resolveRelativeUriStr(const baseUri, relUri: string; var resultUri: string): boolean; function resolveRelativeUriWideStr(const baseUri, relUri: wideString; var resultUri: wideString): boolean; function uriStrToFilename(const uri: string; var path: TFilename; var authority, query, fragment: string): boolean; function uriWideStrToFilename(const uri: wideString; var path: TFilename; var authority, query, fragment: string): boolean; type TUriStrAnalyzer = class protected FUriAuthority: string; FUriFragment: string; FUriQuery: string; FUriPath: string; FUriScheme: string; FHasUriAuthority: boolean; FHasUriFragment: boolean; FHasUriQuery: boolean; FHasUriScheme: boolean; function getUriReference: string; virtual; public constructor create; function setUriAuthority(const Value: string; const isDefined: boolean): boolean; virtual; function setUriFragment(const Value: string; const isDefined: boolean): boolean; virtual; function setUriPath(const Value: string): boolean; virtual; function setUriQuery(const Value: string; const isDefined: boolean): boolean; virtual; function setUriReference(const Value: string): boolean; virtual; function setUriScheme(const Value: string; const isDefined: boolean): boolean; virtual; property HasUriAuthority: boolean read FHasUriAuthority; property HasUriFragment: boolean read FHasUriFragment; property HasUriQuery: boolean read FHasUriQuery; property HasUriScheme: boolean read FHasUriScheme; property UriAuthority: string read FUriAuthority; property UriFragment: string read FUriFragment; property UriPath: string read FUriPath; property UriQuery: string read FUriQuery; property UriReference: string read getUriReference; property UriScheme: string read FUriScheme; end; TUriWideStrAnalyzer = class protected FUriAuthority: wideString; FUriFragment: wideString; FUriQuery: wideString; FUriPath: wideString; FUriScheme: wideString; FHasUriAuthority: boolean; FHasUriFragment: boolean; FHasUriQuery: boolean; FHasUriScheme: boolean; function getUriReference: wideString; virtual; public constructor create; function setUriAuthority(const Value: wideString; const isDefined: boolean): boolean; virtual; function setUriFragment(const Value: wideString; const isDefined: boolean): boolean; virtual; function setUriPath(const Value: wideString): boolean; virtual; function setUriQuery(const Value: wideString; const isDefined: boolean): boolean; virtual; function setUriReference(const Value: wideString): boolean; virtual; function setUriScheme(const Value: wideString; const isDefined: boolean): boolean; virtual; property HasUriAuthority: boolean read FHasUriAuthority; property HasUriFragment: boolean read FHasUriFragment; property HasUriQuery: boolean read FHasUriQuery; property HasUriScheme: boolean read FHasUriScheme; property UriAuthority: wideString read FUriAuthority; property UriFragment: wideString read FUriFragment; property UriPath: wideString read FUriPath; property UriQuery: wideString read FUriQuery; property UriReference: wideString read getUriReference; property UriScheme: wideString read FUriScheme; end; procedure xmlAnalyseEntityDef( source: wideString; var entityValue, systemLiteral, pubidLiteral, nDataName: wideString; var error: boolean); procedure xmlAnalyseNotationDecl(const decl: wideString; var systemLiteral, pubidLiteral: wideString; var error: boolean); procedure xmlAnalysePCDATA(source: wideString; var lines: TdomWideStringList); function xmlAnalysePubSysId(const publicId, systemId, notaName: wideString): wideString; procedure xmlAnalyseTag(const source: wideString; var tagName, attribSequence: wideString); procedure xmlIsolateQuote( source: wideString; var content, rest: wideString; var quoteType: WideChar; var error: boolean); function xmlNormalizeLineBreaks(const source :wideString): wideString; function xmlReplaceQuotes(const source: wideString): wideString; function xmlTrunc(const source: wideString): wideString; procedure xmlTruncAngularBrackets(const source: wideString; var content: wideString; var error: boolean); procedure xmlTruncRoundBrackets(const source: wideString; var content: wideString; var error: boolean); procedure writeWideString(stream: TStream; const xmlStrg: wideString); procedure writeWideStrings(stream: TStream; const xmlStrgs: array of wideString); procedure writeWideChars(stream: TStream; const xmlChars: array of wideChar); var domDocumentFormatList: PdomDocumentFormat = nil; implementation resourcestring SCannotReadOddPos = 'Cannot read WideString from odd byte position'; SCannotWriteOddPos = 'Cannot write WideString to odd byte position'; SCapacityLessSize = 'Capacity cannot be less than size'; SOddSizeInvalid = 'Odd size not valid for WideString'; SNegativeSizeInvalid = 'Negative stream size invalid'; SOddPosInvalid = 'Odd byte position not valid for WideString'; function xmlNormalizeLineBreaks(const source :wideString): wideString; const CR: WideChar = #13; LF: WideChar = #10; CRLF: wideString = #13#10; var nPos: integer; begin Result:= source; // CR+LF --> LF repeat nPos := Pos(CRLF, Result); if nPos > 0 then Delete(Result, nPos, 1); until nPos = 0; // CR --> LF repeat nPos := Pos(CR, Result); if nPos > 0 then Result[nPos] := LF; until nPos = 0; end; procedure xmlAnalysePCDATA(Source: wideString; var Lines: TdomWideStringList); // 'Source': The PCDATA-Sequence to be analyzed. // 'Lines': Returns the content of PCDATA in singles lines containing // only whitespace or only characters without whitespace. var i: integer; Line: string; begin i:= 0; Lines.clear; while i < length(Source) do begin // No White-space? Line:= ''; while i < length(Source) do begin inc(i); if IsXmlWhiteSpace(Source[i]) then begin dec(i); break; end; Line:= Line + Source[i]; end; if Line <> '' then Lines.Add(Line); // White-space? Line:= ''; while i < length(Source) do begin inc(i); if not IsXmlWhiteSpace(Source[i]) then begin dec(i); break; end; Line:= Line + Source[i]; end; if Line <> '' then Lines.Add(Line); end; end; procedure xmlAnalyseTag(const source: wideString; var tagName, AttribSequence: wideString); // 'Source': The tag, to be analyzed. // 'tagName': Returns the namen of the tag. // 'AttribSequence': Returns the Attributes, if existing. var i,j,sourceLength : integer; begin sourceLength:= length(Source); // buffer storage to increase performance // Evaluate tagName: i:= 1; while i <= sourceLength do begin if IsXmlWhiteSpace(Source[i]) then break; inc(i); end; tagName:= copy(Source,1,i-1); // Evaluate Attributes: while i < sourceLength do begin inc(i); if not IsXmlWhiteSpace(Source[i]) then break; end; j:= length(Source); while j >= i do begin if not IsXmlWhiteSpace(Source[j]) then break; dec(j); end; AttribSequence:= copy(Source,i,j-i+1); end; procedure XMLAnalyseEntityDef( Source: wideString; var entityValue, SystemLiteral, PubidLiteral, NDataName: wideString; var Error: boolean); // 'Source': The entity definition to be analyzed. // 'entityValue','SystemLiteral','PubidLiteral','NDataName': // Return the respective values, if declared. // 'Error': Returns 'true', if the entity definition is not well-formed. const SQ: WideChar = #39; // code of ' DQ: WideChar = #34; // code of " var dummy: wideString; i: integer; intro: wideString; rest: wideString; QuoteType: WideChar; PubidLit: wideString; // = '' SystemLit: wideString; // = '' begin QuoteType:= #0; rest := ''; SystemLit := ''; PubidLit := '';; entityValue:= ''; SystemLiteral:= ''; PubidLiteral:= ''; NDataName:= ''; Error:= false; if Length(Source) < 2 then begin Error:= true; exit; end; // Remove leading white space: i:= 1; while i <= length(Source) do begin if not IsXmlWhiteSpace(Source[i]) then break; inc(i); end; if i >= Length(Source) then begin Error:= true; exit; end; dummy:= copy(Source,i,Length(Source)-i+1); Source:= dummy; // Necessary, because of Delphi's problem when copying WideStrings. if (Source[1] = SQ) or (Source[1] = DQ) then begin XMLIsolateQuote(Source,entityValue,rest,QuoteType,Error); if Error then exit; if rest <> '' then begin Error:= true; exit; end; if not isXmlEntityValueChars(entityValue) then begin Error:= true; exit; end; end else begin intro:= copy(Source,1,6); if (intro = 'SYSTEM') or (intro = 'PUBLIC') then begin Dummy:= copy(Source,7,Length(Source)-6); Source:= dummy; // Necessary, because of Delphi's problem when copying WideStrings. if Source = '' then begin Error:= true; exit; end; if not IsXmlWhiteSpace(Source[1]) then begin Error:= true; exit; end; if (intro = 'SYSTEM') then begin XMLIsolateQuote(Source,SystemLit,Source,QuoteType,Error); if Error then exit; end else begin XMLIsolateQuote(Source,PubidLit,Source,QuoteType,Error); if Error then exit; if not isXmlPubidChars(PubidLit) then begin Error:= true; exit; end; XMLIsolateQuote(Source,SystemLit,Source,QuoteType,Error); if Error then exit; end; if Source <> '' then begin if copy(Source,1,5) = 'NDATA' then begin dummy:= copy(Source,6,Length(Source)-5); Source:= XmlTrunc(dummy); // Necessary, because of Delphi's problem when copying WideStrings. if IsXmlName(Source) then NDataName:= Source else begin Error:= true; exit; end; end else begin Error:= true; exit; end; end; end else begin Error:= true; exit; end; SystemLiteral:= SystemLit; PubidLiteral:= PubidLit; end; {if (Source[1] ... } end; procedure XMLAnalyseNotationDecl(const Decl: wideString; var SystemLiteral, PubidLiteral: wideString; var Error: boolean); // 'Source': The notation declaration to be analyzed. // 'SystemLiteral','PubidLiteral','NDataName': // Return the respective values, if declared. // 'Error': Returns 'true', if the notation declaration is not well-formed. var dummy: wideString; intro: wideString; PubidLit: wideString; // = '' QuoteType: WideChar; Source: wideString; SystemLit: wideString; // = '' begin SystemLiteral:= ''; PubidLiteral:= ''; Error:= false; if Length(Decl) < 2 then begin Error:= true; exit; end; Source:= XMLTrunc(Decl); intro:= copy(Source,1,6); if (intro<>'SYSTEM') and (intro<>'PUBLIC') then begin Error:= true; exit; end; Dummy:= copy(Source,7,Length(Source)-6); Source:= dummy; // Necessary, because of Delphi's problem when copying WideStrings. if Source = '' then begin Error:= true; exit; end; if not IsXmlWhiteSpace(Source[1]) then begin Error:= true; exit; end; if (intro = 'SYSTEM') then begin XMLIsolateQuote(Source,SystemLit,dummy,QuoteType,Error); if Error then exit; if dummy <> '' then begin Error:= true; exit; end; end else begin XMLIsolateQuote(Source,PubidLit,dummy,QuoteType,Error); Source:= dummy; if Error then exit; if not isXmlPubidChars(PubidLit) then begin Error:= true; exit; end; if Source <> '' then begin if not IsXmlSystemLiteral(Source) then begin Error:= true; exit; end; SystemLit:= copy(Source,2,length(Source)-2); end; end; SystemLiteral:= SystemLit; PubidLiteral:= PubidLit; end; function xmlReplaceQuotes(const source: wideString): wideString; // This function replaces all single and double quotes // with their respective character references. var i: integer; content: TdomCustomStr; begin result:= ''; content:= TdomCustomStr.create; try for i:= 1 to length(source) do begin case ord(source[i]) of 39: content.addWideString('''); // Single quote 34: content.addWideString('"'); // Double quote else content.addWideChar(source[i]); end; end; Result:= content.value; finally content.free; end; end; function xmlTrunc(const source: wideString): wideString; // This function removes all white space at the beginning // or end of 'Source'. var i: integer; begin result:= ''; i:= 1; while i <= length(Source) do begin if not IsXmlWhiteSpace(Source[i]) then break; inc(i); end; if i > length(Source) then exit; result:= copy(Source,i,Length(Source)-i+1); i:= length(Result); while i > 0 do begin if not IsXmlWhiteSpace(Result[i]) then break; dec(i); end; if i = 0 then result:= '' else result:= copy(result,1,i); end; function XMLTruncSpace(const Source: wideString): wideString; // This function removes all spaces (#$20) at the beginning // or end of 'Source'. const SPACE: WideChar = #$20; var i,startIndex,endIndex: integer; begin startIndex:= length(source)+1; endIndex:= 0; for i:= 1 to length(source) do begin if not (Source[i] = SPACE) then begin startIndex:= i; break; end; end; for i:= length(source) downto startIndex do begin if not (Source[i] = SPACE) then begin endIndex:= i; break; end; end; result:= copy(Source,startIndex,endIndex-startIndex+1); end; procedure XMLTruncAngularBrackets(const Source: wideString; var content: wideString; var Error: boolean); {Die Prozedur entfernt evtl. vorhandenen White-Space am Anfang und Ende von 'Source', prüft dann, ob der verbleibende wideString durch eckige KLammern -- '[' und ']' -- eingerahmt wird. Ist dies der Fall, wird der Klammer-Inhalt in 'content' zurückgegeben und 'Error' wird auf 'false' gesetzt. Ist dies nicht der Fall, gibt 'content' einen leeren wideString ('') zurück und 'Error' wird auf 'true' gesetzt.} var BracketStr: wideString; begin content:= ''; BracketStr:= XMLTrunc(Source); if length(BracketStr) < 2 then begin Error:= true; exit; end; if (BracketStr[1] <> '[') or (BracketStr[length(BracketStr)] <> ']') then Error:= true else begin content:= copy(BracketStr,2,Length(BracketStr)-2); Error:= false; end; end; procedure XMLTruncRoundBrackets(const Source: wideString; var content: wideString; var Error: boolean); {Die Prozedur entfernt evtl. vorhandenen White-Space am Anfang und Ende von 'Source', prüft dann, ob der verbleibende wideString durch runde KLammern -- '(' und ')' -- eingerahmt wird. Ist dies der Fall, wird vom Klammer-Inhalt erneut evtl. vorhandener Leerraum am Anfang und Ende entfernt und das Ergebnis in 'content' zurückgegeben sowie 'Error' auf 'false' gesetzt. Ist dies nicht der Fall, gibt 'content' einen leeren wideString ('') zurück und 'Error' wird auf 'true' gesetzt.} var BracketStr: wideString; begin content:= ''; BracketStr:= XMLTrunc(Source); if length(BracketStr) < 2 then begin Error:= true; exit; end; if (BracketStr[1] <> '(') or (BracketStr[length(BracketStr)] <> ')') then Error:= true else begin content:= XMLTrunc(copy(BracketStr,2,Length(BracketStr)-2)); Error:= false; end; end; procedure xmlIsolateQuote( Source: wideString; var content, rest: wideString; var QuoteType: WideChar; var Error: boolean); {Analysiert einen wideString ('Source'): Führender White-Space wird abgeschnitten, danach wird ein in einfache oder doppelte Anführungs- zeichen gesetzter Text (der auch leer sein kann) erwartet, dessen Inhalt in 'content' zurückgegeben wird. Falls ein Zeichen in 'content' kein legales XML-Zeichen ist, wird 'Error = true' zurückgegen. 'QuoteType' gibt den Wert der Anführungszeichen zurück (#39; für einfache und #34; für doppelte Anführungszeichen). Wird nach dem Entfernen des führenden White-Spaces kein Anführungszeichen gefunden oder fehlt das korrespondierende Schlußzeichen, wird die Routine abgebrochen und 'Error = true' zurückgegeben. Anschließend wird überprüft, ob direkt nach dem Schlußzeichen etwas anderes als White-Space folgt (bzw. der wideString zuende ist). Falls etwas anderes folgt, wird 'Error = true' zurückgegeben. Falls nicht, wird bis zum nächsten Nicht-White-Space-Zeichen gesucht und der Rest des WideStrings in 'rest' zurückgegeben. Für alle Fälle, in denen 'Error = true' zurückgegen wird, werden 'content' und 'rest' als leer ('') und 'QuoteType' als #0; zurückgegeben.} const SQ: WideChar = #39; // code of ' DQ: WideChar = #34; // code of " var i,quotepos: integer; dummy: wideString; begin content:= ''; rest:= ''; if Length(Source) < 2 then begin Error:= true; exit; end; Error:= false; {White-space am Anfang entfernen:} i:= 1; while (i <= length(Source)) do begin if not IsXmlWhiteSpace(Source[i]) then break; inc(i); end; if i >= Length(Source) then begin Error:= true; exit; end; Dummy:= copy(Source,i,Length(Source)-i+1); Source:= dummy; {Diese umständliche Zuweisung ist wegen Delphi-Problem von WideStrings bei copy nötig} QuoteType:= Source[1]; if (QuoteType <> SQ) and (QuoteType <> DQ) then begin QuoteType:= #0; Error:= true; exit; end; Dummy:= Copy(Source,2,Length(Source)-1); Source:= dummy; {Diese umständliche Zuweisung ist wegen Delphi-Problem von WideStrings bei copy nötig} QuotePos:= Pos(wideString(QuoteType),Source); if QuotePos = 0 then begin QuoteType:= #0; Error:= true; exit; end; if Length(Source) > QuotePos then if not IsXmlWhiteSpace(Source[QuotePos+1]) then begin QuoteType:= #0; Error:= true; exit; end; // No White-Space after quotation mark content:= Copy(Source,1,QuotePos-1); if not isXmlChars(content) then begin content:= ''; QuoteType:= #0; Error:= true; exit; end; // Strip White-Space: i:= QuotePos + 1; while (i <= length(Source)) do begin if not IsXmlWhiteSpace(Source[i]) then break; inc(i); end; if i <= Length(Source) then rest:= copy(Source,i,Length(Source)-i+1); end; function xmlAnalysePubSysId(const publicId, systemId, notaName: wideString): wideString; const SQ: wideString = #39; // code of ' DQ: wideString = #34; // code of " var qm: wideString; begin result:= ''; if not isXmlName(notaName) then EConvertError.CreateFmt('%S is not a valid notaName value.',[notaName]);; if isXmlSystemLiteral(concat(DQ,systemId,DQ)) then qm:= DQ else if IsXMLSystemLiteral(concat(SQ,systemId,SQ)) then qm:= SQ else EConvertError.CreateFmt('%S is not a valid systemId value.',[systemId]);; if not isXmlPubidChars(publicId) then EConvertError.CreateFmt('%S is not a valid publicId value.',[publicId]);; if publicId = '' then begin result:= concat(result,wideString(' SYSTEM '),qm,systemId,qm,wideString(' ')); end else begin if systemId = '' then begin result:= concat(result,wideString(' PUBLIC "'),publicId,wideString('" ')); end else begin result:= concat(result,wideString(' PUBLIC "'),publicId,wideString('" '),qm,systemId,qm,wideString(' ')); end; end; {if ...} if notaName <> '' then result:= concat(result,wideString('NDATA '),notaName,wideString(' ')); end; function trimWhitespace(S: wideString): wideString; var i, l: integer; begin l:= Length(S); i:= 1; while (i <= l) and IsXmlWhiteSpace(S[i]) do inc(i); if i > l then result:= '' else begin while IsXmlWhiteSpace(S[l]) do dec(l); result:= copy(S,i,l-i+1); end; end; function trimWhitespaceLeft(S: wideString): wideString; var i, l: integer; begin l:= Length(S); i:= 1; while (i <= l) and IsXmlWhiteSpace(S[i]) do inc(i); result:= copy(s,i,Maxint); end; function trimWhitespaceRight(S: wideString): wideString; var i: integer; begin i:= Length(S); while (i > 0) and IsXmlWhiteSpace(S[i]) do dec(I); result:= copy(s,1,i); end; function xmlExtractPrefix(const qualifiedName: wideString): wideString; var colonpos: integer; localpart: wideString; // = 0 prefix: wideString; // = 0 begin colonpos:= pos(':',qualifiedName); if colonpos = 0 then localpart:= qualifiedName else begin prefix:= copy(qualifiedName,1,colonpos-1); localpart:= copy(qualifiedName,colonpos+1,length(qualifiedName)-colonpos); if not IsXmlPrefix(prefix) then raise EInvalid_Character_Err.create('Invalid character error.'); end; if not IsXmlLocalPart(localpart) then raise EInvalid_Character_Err.create('Invalid character error.'); result:= prefix; end; function xmlExtractLocalName(const qualifiedName: wideString): wideString; var colonpos: integer; prefix,localpart: wideString; begin colonpos:= pos(':',qualifiedName); if colonpos = 0 then localpart:= qualifiedName else begin prefix:= copy(qualifiedName,1,colonpos-1); localpart:= copy(qualifiedName,colonpos+1,length(qualifiedName)-colonpos); if not IsXmlPrefix(prefix) then raise EInvalid_Character_Err.create('Invalid character error.'); end; if not IsXmlLocalPart(localpart) then raise EInvalid_Character_Err.create('Invalid character error.'); result:= localpart; end; function xmlExtractPrefixAndLocalName(const qualifiedName: wideString; out prefix, localName: wideString): boolean; var colonpos: integer; begin colonpos:= pos(':',qualifiedName); if colonpos = 0 then begin prefix:= ''; if IsXmlLocalPart(qualifiedName) then begin localName:= qualifiedName; result:= true; end else begin localName:= ''; result:= false; end; end else begin prefix:= copy(qualifiedName,1,colonpos-1); localName:= copy(qualifiedName,colonpos+1,length(qualifiedName)-colonpos); if IsXmlPrefix(prefix) and IsXmlLocalPart(localName) then begin result:= true; end else begin prefix:= ''; localName:= ''; result:= false; end; end; end; function IsXmlChar(const S: WideChar): boolean; begin case Word(S) of $0009,$000A,$000D,$0020..$D7FF,$E000..$FFFD, // Unicode below $FFFF $D800..$DBFF, // High surrogate of Unicode character [$10000..$10FFFF] $DC00..$DFFF: // Low surrogate of Unicode character [$10000..$10FFFF] result:= true; else result:= false; end; end; function IsXmlWhiteSpace(const S: WideChar): boolean; begin Case Word(S) of $0009,$000A,$000D,$0020: result:= true; else result:= false; end; end; function IsXmlLetter(const S: WideChar): boolean; begin Result:= IsXmlIdeographic(S) or IsXmlBaseChar(S); end; function IsXmlBaseChar(const S: WideChar): boolean; begin Case Word(S) of $0041..$005a,$0061..$007a,$00c0..$00d6,$00d8..$00f6,$00f8..$00ff, $0100..$0131,$0134..$013E,$0141..$0148,$014a..$017e,$0180..$01c3, $01cd..$01f0,$01f4..$01f5,$01fa..$0217,$0250..$02a8,$02bb..$02c1, $0386,$0388..$038a,$038c,$038e..$03a1,$03a3..$03ce,$03D0..$03D6, $03DA,$03DC,$03DE,$03E0,$03E2..$03F3,$0401..$040C,$040E..$044F, $0451..$045C,$045E..$0481,$0490..$04C4,$04C7..$04C8,$04CB..$04CC, $04D0..$04EB,$04EE..$04F5,$04F8..$04F9,$0531..$0556,$0559, $0561..$0586,$05D0..$05EA,$05F0..$05F2,$0621..$063A,$0641..$064A, $0671..$06B7,$06BA..$06BE,$06C0..$06CE,$06D0..$06D3,$06D5, $06E5..$06E6,$0905..$0939,$093D,$0958..$0961,$0985..$098C, $098F..$0990,$0993..$09A8,$09AA..$09B0,$09B2,$09B6..$09B9, $09DC..$09DD,$09DF..$09E1,$09F0..$09F1,$0A05..$0A0A,$0A0F..$0A10, $0A13..$0A28,$0A2A..$0A30,$0A32..$0A33,$0A35..$0A36,$0A38..$0A39, $0A59..$0A5C,$0A5E,$0A72..$0A74,$0A85..$0A8B,$0A8D,$0A8F..$0A91, $0A93..$0AA8,$0AAA..$0AB0,$0AB2..$0AB3,$0AB5..$0AB9,$0ABD,$0AE0, $0B05..$0B0C,$0B0F..$0B10,$0B13..$0B28,$0B2A..$0B30,$0B32..$0B33, $0B36..$0B39,$0B3D,$0B5C..$0B5D,$0B5F..$0B61,$0B85..$0B8A, $0B8E..$0B90,$0B92..$0B95,$0B99..$0B9A,$0B9C,$0B9E..$0B9F, $0BA3..$0BA4,$0BA8..$0BAA,$0BAE..$0BB5,$0BB7..$0BB9,$0C05..$0C0C, $0C0E..$0C10,$0C12..$0C28,$0C2A..$0C33,$0C35..$0C39,$0C60..$0C61, $0C85..$0C8C,$0C8E..$0C90,$0C92..$0CA8,$0CAA..$0CB3,$0CB5..$0CB9, $0CDE,$0CE0..$0CE1,$0D05..$0D0C,$0D0E..$0D10,$0D12..$0D28, $0D2A..$0D39,$0D60..$0D61,$0E01..$0E2E,$0E30,$0E32..$0E33, $0E40..$0E45,$0E81..$0E82,$0E84,$0E87..$0E88,$0E8A,$0E8D, $0E94..$0E97,$0E99..$0E9F,$0EA1..$0EA3,$0EA5,$0EA7,$0EAA..$0EAB, $0EAD..$0EAE,$0EB0,$0EB2..$0EB3,$0EBD,$0EC0..$0EC4,$0F40..$0F47, $0F49..$0F69,$10A0..$10C5,$10D0..$10F6,$1100,$1102..$1103, $1105..$1107,$1109,$110B..$110C,$110E..$1112,$113C,$113E,$1140, $114C,$114E,$1150,$1154..$1155,$1159,$115F..$1161,$1163,$1165, $1167,$1169,$116D..$116E,$1172..$1173,$1175,$119E,$11A8,$11AB, $11AE..$11AF,$11B7..$11B8,$11BA,$11BC..$11C2,$11EB,$11F0,$11F9, $1E00..$1E9B,$1EA0..$1EF9,$1F00..$1F15,$1F18..$1F1D,$1F20..$1F45, $1F48..$1F4D,$1F50..$1F57,$1F59,$1F5B,$1F5D,$1F5F..$1F7D, $1F80..$1FB4,$1FB6..$1FBC,$1FBE,$1FC2..$1FC4,$1FC6..$1FCC, $1FD0..$1FD3,$1FD6..$1FDB,$1FE0..$1FEC,$1FF2..$1FF4,$1FF6..$1FFC, $2126,$212A..$212B,$212E,$2180..$2182,$3041..$3094,$30A1..$30FA, $3105..$312C,$AC00..$d7a3: result:= true; else result:= false; end; end; function IsXmlIdeographic(const S: WideChar): boolean; begin Case Word(S) of $4E00..$9FA5,$3007,$3021..$3029: result:= true; else result:= false; end; end; function IsXmlCombiningChar(const S: WideChar): boolean; begin Case Word(S) of $0300..$0345,$0360..$0361,$0483..$0486,$0591..$05A1,$05A3..$05B9, $05BB..$05BD,$05BF,$05C1..$05C2,$05C4,$064B..$0652,$0670, $06D6..$06DC,$06DD..$06DF,$06E0..$06E4,$06E7..$06E8,$06EA..$06ED, $0901..$0903,$093C,$093E..$094C,$094D,$0951..$0954,$0962..$0963, $0981..$0983,$09BC,$09BE,$09BF,$09C0..$09C4,$09C7..$09C8, $09CB..$09CD,$09D7,$09E2..$09E3,$0A02,$0A3C,$0A3E,$0A3F, $0A40..$0A42,$0A47..$0A48,$0A4B..$0A4D,$0A70..$0A71,$0A81..$0A83, $0ABC,$0ABE..$0AC5,$0AC7..$0AC9,$0ACB..$0ACD,$0B01..$0B03,$0B3C, $0B3E..$0B43,$0B47..$0B48,$0B4B..$0B4D,$0B56..$0B57,$0B82..$0B83, $0BBE..$0BC2,$0BC6..$0BC8,$0BCA..$0BCD,$0BD7,$0C01..$0C03, $0C3E..$0C44,$0C46..$0C48,$0C4A..$0C4D,$0C55..$0C56,$0C82..$0C83, $0CBE..$0CC4,$0CC6..$0CC8,$0CCA..$0CCD,$0CD5..$0CD6,$0D02..$0D03, $0D3E..$0D43,$0D46..$0D48,$0D4A..$0D4D,$0D57,$0E31,$0E34..$0E3A, $0E47..$0E4E,$0EB1,$0EB4..$0EB9,$0EBB..$0EBC,$0EC8..$0ECD, $0F18..$0F19,$0F35,$0F37,$0F39,$0F3E,$0F3F,$0F71..$0F84, $0F86..$0F8B,$0F90..$0F95,$0F97,$0F99..$0FAD,$0FB1..$0FB7,$0FB9, $20D0..$20DC,$20E1,$302A..$302F,$3099,$309A: result:= true; else result:= false; end; end; function IsXmlDigit(const S: WideChar): boolean; begin Case Word(S) of $0030..$0039,$0660..$0669,$06F0..$06F9,$0966..$096F,$09E6..$09EF, $0A66..$0A6F,$0AE6..$0AEF,$0B66..$0B6F,$0BE7..$0BEF,$0C66..$0C6F, $0CE6..$0CEF,$0D66..$0D6F,$0E50..$0E59,$0ED0..$0ED9,$0F20..$0F29: result:= true; else result:= false; end; end; function IsXmlExtender(const S: WideChar): boolean; begin Case Word(S) of $00B7,$02D0,$02D1,$0387,$0640,$0E46,$0EC6,$3005,$3031..$3035, $309D..$309E,$30FC..$30FE: result:= true; else result:= false; end; end; function IsXmlNameChar(const S: WideChar): boolean; begin if IsXmlLetter(S) or IsXmlDigit(S) or IsXmlCombiningChar(S) or IsXmlExtender(S) or (S='.') or (S='-') or (S='_') or (S=':') then Result:= true else Result:= false; end; function IsXmlPubidChar(const S: WideChar): boolean; begin if (S=#$20) or (S=#$D) or (S=#$A) or ((S>='a') and (S<='z')) or ((S>='A') and (S<='Z')) or ((S>='0') and (S<='9')) or (S='-') or (S=#$27) or (S='(') or (S=')') or (S='+') or (S=',') or (S='.') or (S='/') or (S=':') or (S='=') or (S=WideChar('?')) or (S=';') or (S='!') or (S='*') or (S='#') or (S='@') or (S='$') or (S='_') or (S='%') then Result:= true else Result:= false; end; function isXmlChars(const S: wideString): boolean; var i,l: integer; sChar: wideChar; begin result:= true; i:= 0; l:= length(S); while i < l do begin inc(i); sChar:= S[i]; case Word(sChar) of $0009,$000A,$000D,$0020..$D7FF,$E000..$FFFD: // Unicode below $FFFF ; // do nothing. $D800..$DBFF: // High surrogate of Unicode character [$10000..$10FFFF] begin if i = l then begin result:= false; break; end; // End of wideString --> No low surrogate found inc(i); sChar:= S[i]; if not IsUtf16LowSurrogate(sChar) then begin result:= false; break; end; // No low surrogate found end; else begin result:= false; break; end; end; {case ...} end; {while ...} end; function IsXmlS(const S: wideString): boolean; var i: integer; begin if Length(S) = 0 then begin Result:= false; exit; end; Result:= true; for i:= 1 to length(S) do if not IsXmlWhiteSpace((PWideChar(S)+i-1)^) then begin Result:= false; exit; end; end; function IsXmlName(const S: wideString): boolean; var i: integer; begin Result:= true; if Length(S) = 0 then begin Result:= false; exit; end; if not ( IsXmlLetter(PWideChar(S)^) or (PWideChar(S)^ = '_') or (PWideChar(S)^ = ':') ) then begin Result:= false; exit; end; for i:= 2 to length(S) do if not IsXmlNameChar((PWideChar(S)+i-1)^) then begin Result:= false; exit; end; end; function IsXmlNames(const S: wideString): boolean; const SPACE: WideChar = #$20; var i,j: integer; namesStr: wideString; begin Result:= true; namesStr:= concat(S,wideString(SPACE)); j:= 1; for i:= 1 to length(namesStr) do begin if namesStr[i] = SPACE then begin if not IsXmlName(copy(namesStr,j,i-j)) then begin Result:= false; exit; end; j:= i+1; end; end; end; function IsXmlNmtoken(const S: wideString): boolean; var i: integer; begin Result:= true; if length(S) = 0 then begin Result:= false; exit; end; for i:= 1 to length(S) do if not IsXmlNameChar((PWideChar(S)+i-1)^) then begin Result:= false; exit; end; end; function IsXmlNmtokens(const S: wideString): boolean; const SPACE: WideChar = #$20; var i,j: integer; NmtokensStr: wideString; begin Result:= true; NmtokensStr:= concat(S,wideString(SPACE)); j:= 1; for i:= 1 to length(NmtokensStr) do begin if NmtokensStr[i] = SPACE then begin if not IsXmlNmtoken(copy(NmtokensStr,j,i-j)) then begin Result:= false; exit; end; j:= i+1; end; end; end; function IsXmlCharRef(const S: wideString): boolean; var i: integer; SChar: widechar; begin Result:= true; if copy(S,length(S),1) <> ';' then begin result:= false; exit; end; if copy(S,1,3) = '&#x' then begin if Length(S) < 5 then begin Result:= false; exit; end; for i:= 4 to length(S)-1 do begin SChar:= WideChar((PWideChar(S)+i-1)^); if not ( (SChar >= '0') and (SChar <= '9') ) and not ( (SChar >= 'a') and (SChar <= 'f') ) and not ( (SChar >= 'A') and (SChar <= 'F') ) then begin Result:= false; exit; end; end; end else begin if Length(S) < 4 then begin Result:= false; exit; end; if copy(S,1,2) <> '&#' then begin Result:= false; exit; end; for i:= 3 to length(S)-1 do begin SChar:= WideChar((PWideChar(S)+i-1)^); if not ( (SChar >= '0') and (SChar <= '9') ) then begin Result:= false; exit; end; end; end; end; function IsXmlEntityRef(const S: wideString): boolean; begin if pos('&',S) <> 1 then begin result:= false; exit; end; if copy(S,length(S),1) <> ';' then begin result:= false; exit; end; Result:= IsXmlName(copy(S,2,length(S)-2)); end; function IsXmlPEReference(const S: wideString): boolean; begin if pos('%',S) <> 1 then begin result:= false; exit; end; if copy(S,length(S),1) <> ';' then begin result:= false; exit; end; Result:= IsXmlName(copy(S,2,length(S)-2)); end; function isXmlReference(const S: wideString): boolean; begin if IsXmlEntityRef(s) or IsXmlCharRef(s) then result:= true else result:= false; end; function isXmlEntityValue(const S: wideString): boolean; const sQuote: widechar = #$0027; dQuote: widechar = '"'; var i,j,indexpos: integer; SChar, SChar2, ForbittenQuote: widechar; begin Result:= true; if Length(S) < 2 then begin Result:= false; exit; end; if (S[length(S)] = sQuote) and (S[1] = sQuote) {single quotes} then ForbittenQuote:= sQuote else if (S[length(S)] = dQuote) and (S[1] = dQuote) {double quotes} then ForbittenQuote:= dQuote else begin Result:= false; exit; end; i:= 2; while i < length(S) do begin SChar:= WideChar((PWideChar(S)+i-1)^); if IsUtf16LowSurrogate(sChar) then begin Result:= false; exit; end; if IsUtf16HighSurrogate(SChar) then begin if i+1 = length(s) then begin Result:= false; exit; end; inc(i); SChar:= WideChar((PWideChar(S)+i-1)^); if not IsUtf16LowSurrogate(SChar) then begin Result:= false; exit; end; end; if not IsXmlChar(sChar) then begin Result:= false; exit; end; if SChar = ForbittenQuote then begin Result:= false; exit; end; if SChar = '%' then begin {PEReference?} indexpos:= -1; for j:= i+1 to length(S)-1 do begin SChar2:= WideChar((PWideChar(S)+j-1)^); if SChar2 = ';' then begin indexpos:= j; break; end; end; if indexpos = -1 then begin Result:= false; exit; end; if not IsXmlPEReference(copy(S,i,j-i+1)) then begin Result:= false; exit; end; i:= j; end; if SChar = '&' then begin {Reference?} indexpos:= -1; for j:= i+1 to length(S)-1 do begin SChar2:= WideChar((PWideChar(S)+j-1)^); if SChar2 = ';' then begin indexpos:= j; break; end; end; if indexpos = -1 then begin Result:= false; exit; end; if not IsXmlReference(copy(S,i,j-i+1)) then begin Result:= false; exit; end; i:= j; end; inc(i); end; end; function isXmlEntityValueChars(const S: wideString): boolean; // Returns 'true' if S consists only of legal XML characters and // legal XML references and there are either only single or only // double quotation marks in S, or if S is an empty wideString. // Otherwise 'false' is returned. const SEMICOLON: WideChar = #$3B; // ';' var firstCharPos,i,l: integer; sChar: wideChar; dqFound,sqFound: boolean; begin result:= true; dqFound:= false; sqFound:= false; i:= 0; l:= length(S); while i < l do begin inc(i); sChar:= S[i]; case Word(sChar) of $0022: // Double quote (") if sqFound then begin result:= false; exit; end else dqFound:= true; $0026: // Ampersand (&) begin result:= false; firstCharPos:= i; while i < l do begin inc(i); sChar:= S[i]; if sChar = SEMICOLON then begin if IsXmlReference(copy(S,firstCharPos,i-firstCharPos+1)) then begin result:= true; break end else exit; end; {if ...} end; {while ...} end; // xxx What about % ? $0027: // Single quote (') if dqFound then begin result:= false; exit; end else sqFound:= true; $0009,$000A,$000D,$0020,$0021,$0023..$0025,$0028..$D7FF,$E000..$FFFD: // Unicode below $FFFF ; // do nothing. $D800..$DBFF: // High surrogate of Unicode character [$10000..$10FFFF] begin if i = l then begin result:= false; exit; end; // End of wideString --> No low surrogate found inc(i); sChar:= S[i]; if not IsUtf16LowSurrogate(sChar) then begin result:= false; exit; end; // No low surrogate found end; else begin result:= false; exit; end; end; {case ...} end; {while ...} end; function isXmlAttValue(const S: wideString): boolean; const sQuote: widechar = #$0027; dQuote: widechar = '"'; var i,j,indexpos: integer; SChar, SChar2, ForbittenQuote: widechar; begin Result:= true; if Length(S) < 2 then begin Result:= false; exit; end; if (S[length(S)] = sQuote) and (S[1] = sQuote) {single quotes} then ForbittenQuote:= sQuote else if (S[length(S)] = dQuote) and (S[1] = dQuote) {double quotes} then ForbittenQuote:= dQuote else begin Result:= false; exit; end; i:= 2; while i < length(S) do begin SChar:= WideChar((PWideChar(S)+i-1)^); if IsUtf16LowSurrogate(sChar) then begin Result:= false; exit; end; if IsUtf16HighSurrogate(SChar) then begin if i+1 = length(s) then begin Result:= false; exit; end; inc(i); SChar:= WideChar((PWideChar(S)+i-1)^); if not IsUtf16LowSurrogate(SChar) then begin Result:= false; exit; end; end; if not IsXmlChar(sChar) then begin Result:= false; exit; end; if SChar = ForbittenQuote then begin Result:= false; exit; end; if SChar = '<' then begin Result:= false; exit; end; if SChar = '&' then begin {Reference?} indexpos:= -1; for j:= i+1 to length(S)-1 do begin SChar2:= WideChar((PWideChar(S)+j-1)^); if SChar2 = ';' then begin indexpos:= j; break; end; end; if indexpos = -1 then begin Result:= false; exit; end; if not IsXmlReference(copy(S,i,j-i+1)) then begin Result:= false; exit; end; i:= j; end; inc(i); end; end; function IsXmlSystemLiteral(const S: wideString): boolean; const sQuote: widechar = #$0027; dQuote: widechar = '"'; var i,l: integer; SChar, ForbittenQuote: widechar; begin Result:= true; if Length(S) < 2 then begin Result:= false; exit; end; if (S[length(S)] = sQuote) and (S[1] = sQuote) {single quotes} then ForbittenQuote:= sQuote else if (S[length(S)] = dQuote) and (S[1] = dQuote) {double quotes} then ForbittenQuote:= dQuote else begin Result:= false; exit; end; i:= 1; l:= length(S)-1; while i < l do begin inc(i); SChar:= WideChar((PWideChar(S)+i-1)^); if IsUtf16LowSurrogate(sChar) then begin Result:= false; exit; end; if IsUtf16HighSurrogate(SChar) then begin if i+1 = length(s) then begin Result:= false; exit; end; inc(i); SChar:= WideChar((PWideChar(S)+i-1)^); if not IsUtf16LowSurrogate(SChar) then begin Result:= false; exit; end; end else if not IsXmlChar(sChar) then begin Result:= false; exit; end; if SChar = ForbittenQuote then begin Result:= false; exit; end; end; end; function isXmlSystemChars(const S: wideString): boolean; // Returns 'true' if all characters in S are legal XML characters // and there are either only single or only double quotation marks // in S, or if S is an empty wideString. // Otherwise 'false' is returned. var i,l: integer; sChar: wideChar; dqFound,sqFound: boolean; begin result:= true; dqFound:= false; sqFound:= false; i:= 0; l:= length(S); while i < l do begin inc(i); sChar:= S[i]; case Word(sChar) of $0022: // Double quote (") if sqFound then begin result:= false; break; end else dqFound:= true; $0027: // Single quote (') if dqFound then begin result:= false; break; end else sqFound:= true; $0009,$000A,$000D,$0020,$0021,$0023..$0026,$0028..$D7FF,$E000..$FFFD: // Unicode below $FFFF ; // do nothing. $D800..$DBFF: // High surrogate of Unicode character [$10000..$10FFFF] begin if i = l then begin result:= false; break; end; // End of wideString --> No low surrogate found inc(i); sChar:= S[i]; if not IsUtf16LowSurrogate(sChar) then begin result:= false; break; end; // No low surrogate found end; else begin result:= false; break; end; end; {case ...} end; {while ...} end; function IsXmlPubidLiteral(const S: wideString): boolean; const SQ: WideChar = #39; // code of ' DQ: WideChar = #34; // code of " var i: integer; SChar: widechar; begin Result:= true; if Length(S) < 2 then begin Result:= false; exit; end; if (S[length(S)] = SQ) and (S[1] = SQ) then begin // single quotes for i:= 2 to length(S)-1 do begin SChar:= WideChar((PWideChar(S)+i-1)^); if (SChar = SQ) or not IsXmlPubidChar(SChar) then begin Result:= false; exit; end; end; end else if (S[length(S)] = DQ) and (S[1] = DQ) then begin // double quotes for i:= 2 to length(S)-1 do begin SChar:= WideChar((PWideChar(S)+i-1)^); if not IsXmlPubidChar(SChar) then begin Result:= false; exit; end; end; end else begin Result:= false; exit; end; end; function isXmlPubidChars(const S: wideString): boolean; // Returns 'true' if all characters in S belong to the XML PubidChar class // (see XML 1.0, 2nd ed., prod. [13], or if S is an empty wideString. // Otherwise 'false' is returned. var i: integer; SChar: widechar; begin Result:= true; for i:= 1 to length(S) do begin SChar:= WideChar((PWideChar(S)+i-1)^); if not IsXmlPubidChar(SChar) then begin Result:= false; exit; end; end; end; function IsXmlComment(const S: wideString): boolean; var i,lengthS: integer; SChar: wideChar; S2: wideString; begin Result:= true; lengthS:= length(S); if lengthS < 7 then begin result:= false; exit; end; if copy(S,1,4) <> '' then begin result:= false; exit; end; if lengthS = 7 then exit; // Empty comment --> ok. SChar:= WideChar((PWideChar(S)+lengthS-4)^); if SChar = '-' then begin result:= false; exit; end; S2:= copy(S,5,lengthS-7); if pos('--',S2) > 0 then begin result:= false; exit; end; i:= 0; while i < pred(length(S2)) do begin inc(i); SChar:= S2[i]; if IsUtf16LowSurrogate(sChar) then begin Result:= false; exit; end; if IsUtf16HighSurrogate(SChar) then begin if i = length(S2) then begin Result:= false; exit; end; inc(i); SChar:= S2[i]; if not IsUtf16LowSurrogate(SChar) then begin Result:= false; exit; end; end; if not IsXmlChar(sChar) then begin Result:= false; exit; end; end; end; function IsXmlCData(const S: wideString): boolean; var i: integer; SChar: wideChar; begin Result:= true; if pos(']]>',S) > 0 then begin result:= false; exit; end; i:= 0; while i < length(S) do begin inc(i); SChar:= S[i]; if IsUtf16LowSurrogate(sChar) then begin Result:= false; exit; end; if IsUtf16HighSurrogate(SChar) then begin if i = length(s) then begin Result:= false; exit; end; inc(i); SChar:= S[i]; if not IsUtf16LowSurrogate(SChar) then begin Result:= false; exit; end; end; if not IsXmlChar(sChar) then begin Result:= false; exit; end; end; end; function IsXmlCharData(const S: wideString): boolean; var i: integer; SChar: wideChar; begin Result:= true; i:= 0; while i < length(S) do begin inc(i); SChar:= S[i]; if IsUtf16LowSurrogate(sChar) then begin Result:= false; exit; end; if IsUtf16HighSurrogate(SChar) then begin if i = length(s) then begin Result:= false; exit; end; inc(i); SChar:= S[i]; if not IsUtf16LowSurrogate(SChar) then begin Result:= false; exit; end; end; if not IsXmlChar(sChar) then begin Result:= false; exit; end; if SChar = '<' then begin Result:= false; exit; end; if SChar = '&' then begin Result:= false; exit; end; end; end; function IsXmlPITarget(const S: wideString): boolean; begin Result:= IsXmlName(S); if length(S) = 3 then if ((S[1] = 'X') or (S[1] = 'x')) and ((S[2] = 'M') or (S[2] = 'm')) and ((S[3] = 'L') or (S[3] = 'l')) then Result:= false; end; function isXmlVersionNumChar(const s: WideChar): boolean; begin if ( ((s >= 'a') and (s <= 'z')) or ((s >= 'A') and (s <= 'Z')) or ((s >= '0') and (s <= '9')) or (s = '_') or (s = '.') or (s = ':') or (s = '-') ) then result:= true else result:= false; end; function IsXmlVersionNum(const S: wideString): boolean; var i: integer; begin Result:= true; if Length(S) = 0 then begin Result:= false; exit; end; for i:= 1 to length(S) do begin if not isXmlVersionNumChar(S[i]) then begin Result:= false; exit; end; end; end; function isXmlEncNameLeadingChar(const s: WideChar): boolean; begin if ( ((s >= 'a') and (s <= 'z')) or ((s >= 'A') and (s <= 'Z')) ) then result:= true else result:= false; end; function isXmlEncNameFollowingChar(const s: WideChar): boolean; begin if ( ((s >= 'a') and (s <= 'z')) or ((s >= 'A') and (s <= 'Z')) or ((s >= '0') and (s <= '9')) or (s = '.') or (s = '_') or (s = '-') ) then result:= true else result:= false; end; function IsXmlEncName(const S: wideString): boolean; var i: integer; begin result:= true; if length(S) = 0 then begin result:= false; exit; end; if not isXmlEncNameLeadingChar(S[1]) then begin result:= false; exit; end; for i:= 2 to length(S) do begin if not isXmlEncNameFollowingChar(S[i]) then begin result:= false; exit; end; end; end; function IsXmlStringType(const S: wideString): boolean; begin if S = 'CDATA' then Result:= true else Result:= false; end; function IsXmlTokenizedType(const S: wideString): boolean; begin if (S='ID') or (S='IDREF') or (S='IDREFS') or (S='ENTITY') or (S='ENTITIES') or (S='NMTOKEN') or (S='NMTOKENS') then Result:= true else Result:= false; end; function IsXmlNCNameChar(const s: WideChar): boolean; begin if IsXmlLetter(S) or IsXmlDigit(S) or IsXmlCombiningChar(S) or IsXmlExtender(S) or (S='.') or (S='-') or (S='_') then Result:= true else Result:= false; end; function IsXmlNCName(const S: wideString): boolean; var i: integer; begin Result:= true; if Length(S) = 0 then begin Result:= false; exit; end; if not ( IsXmlLetter(PWideChar(S)^) or (PWideChar(S)^ = '_') ) then begin Result:= false; exit; end; for i:= 2 to length(S) do if not IsXmlNCNameChar(S[i]) then begin Result:= false; exit; end; end; function IsXmlDefaultAttName(const S: wideString): boolean; begin if S = 'xmlns' then Result:= true else Result:= false; end; function IsXmlPrefixedAttName(const S: wideString): boolean; var piece: wideString; begin if copy(S,1,6) = 'xmlns:' then begin piece:= copy(S,7,length(S)-6); Result:= IsXmlNCName(piece); end else Result:= false; end; function IsXmlNSAttName(const S: wideString): boolean; begin Result:= (IsXmlPrefixedAttName(S) or IsXmlDefaultAttName(S)); end; function IsXmlLocalPart(const S: wideString): boolean; begin Result:= IsXmlNCName(S); end; function IsXmlPrefix(const S: wideString): boolean; begin Result:= IsXmlNCName(S); end; function IsXmlQName(const S: wideString): boolean; var colonpos: integer; prefix,localpart: wideString; begin colonpos:= pos(':',S); if colonpos = 0 then result:= IsXmlLocalPart(S) else begin prefix:= copy(S,1,colonpos-1); localpart:= copy(S,colonpos+1,length(S)-colonpos); result:= IsXmlPrefix(prefix) and IsXmlLocalPart(localpart); end; end; function ResolveCharRefs(const S: wideString): wideString; var i,j,indexpos: integer; SChar, SChar2: widechar; ref: wideString; content: TdomCustomStr; begin result:= ''; content:= TdomCustomStr.create; try i:= 1; while i <= length(S) do begin SChar:= WideChar((PWideChar(S)+i-1)^); if IsUtf16LowSurrogate(sChar) then raise EConvertError.CreateFmt('%S must not start with a UTF-16 low surrogate.',[S]); if IsUtf16HighSurrogate(SChar) then begin if i+1 > length(s) then raise EConvertError.CreateFmt('%S must not end with a UTF-16 high surrogate.',[S]); inc(i); content.addWideChar(SChar); SChar:= WideChar((PWideChar(S)+i-1)^); if not IsUtf16LowSurrogate(SChar) then raise EConvertError.CreateFmt('%S contains an UTF-16 high surrogate without its corresponding low surrogate.',[S]); end; if not IsXmlChar(sChar) then raise EConvertError.CreateFmt('%S contains an invalid character.',[S]); if SChar = '&' then begin {Reference?} indexpos:= -1; for j:= i+1 to length(S) do begin SChar2:= WideChar((PWideChar(S)+j-1)^); if SChar2 = ';' then begin indexpos:= j; break; end; end; if indexpos = -1 then raise EConvertError.CreateFmt('%S contains an ''&'' without a '';''.',[S]); ref:= copy(S,i,j-i+1); if IsXmlEntityRef(ref) then begin content.addWideString(ref); end else if IsXmlCharRef(ref) then begin content.addWideString(XmlCharRefToStr(ref)); end else raise EConvertError.CreateFmt('%S contains an invalid reference.',[S]); i:= j; end else content.addWideChar(SChar); inc(i); end; {while ...} Result:= content.value; finally content.free; end; end; function XmlIntToCharRef(const value: integer): wideString; begin Result:= concat('&#',intToStr(value),';'); end; function XmlCharRefToInt(const S: wideString): integer; var value: word; begin if not IsXmlCharRef(S) then raise EConvertError.CreateFmt('%S is not a valid XmlCharRef value.',[S]); if S[3] = 'x' then Result:= StrToInt(concat('$',copy(S,4,length(S)-4))) // Hex else Result:= StrToInt(copy(S,3,length(S)-3)); // Dec if Result > $10FFFF then raise EConvertError.CreateFmt('%S is not a valid XmlCharRef value.',[S]); if Result < $10000 then begin value:= Result; if not IsXmlChar(WideChar(value)) then raise EConvertError.CreateFmt('%S is not a valid XmlCharRef value.',[S]); case result of $D800..$DBFF, // Reserved for high surrogate of Unicode character [$10000..$10FFFF] $DC00..$DFFF: // Reserved for low surrogate of Unicode character [$10000..$10FFFF] raise EConvertError.CreateFmt('%S is not a valid XmlCharRef value.',[S]); end; {case ...} end; {if ...} end; function XmlCharRefToStr(const S: wideString): wideString; var value: integer; smallValue: word; begin value:= XmlCharRefToInt(S); if value < $10000 then begin smallValue:= value; Result:= wideString(WideChar(smallValue)); end else Result:= concat(wideString(Utf16HighSurrogate(value)), wideString(Utf16LowSurrogate(value))); end; function XmlStrToCharRef(const S: wideString): wideString; var SChar,LowSur: widechar; i: integer; begin result:= ''; i:= 0; while i < length(S) do begin inc(i); SChar:= S[i]; if not isXmlChar(SChar) then raise EConvertError.CreateFmt('String contains invalid character %S.',[S]); if isUtf16LowSurrogate(SChar) then raise EConvertError.CreateFmt('Low surrogate %S without high surrogate.',[S]); if isUtf16HighSurrogate(SChar) then begin if i+1 = length(s) then raise EConvertError.CreateFmt('High surrogate %S without low surrogate at end of string.',[S]); inc(i); lowSur:= S[i]; if not IsUtf16LowSurrogate(lowSur) then raise EConvertError.CreateFmt('High surrogate %S without low surrogate.',[S]); result:= concat(result,XmlIntToCharRef(Utf16SurrogateToInt(SChar,lowSur))); end else begin result:= concat(result,XmlIntToCharRef(ord(SChar))); end; end; {for ...} end; function isAbnfALPHAWideChar(c: wideChar): boolean; begin case word(c) of $0041..$005A,$0061..$007A: result:= true; else result:= false; end; end; function isAbnfBITWideChar(c: wideChar): boolean; begin if (c = '0') or (c = '1') then result:= true else result:= false; end; function isAbnfCHARWideChar(c: wideChar): boolean; begin case word(c) of $0001..$007F: result:= true; else result:= false; end; end; function isAbnfCRWideChar(c: wideChar): boolean; begin if c = #$0D then result:= true else result:= false; end; function isAbnfCRLFWideStr(s: wideString): boolean; begin if s = #$0D#$0A then result:= true else result:= false; end; function isAbnfCTLWideChar(c: wideChar): boolean; begin case word(c) of $0000..$001F,$007F: result:= true; else result:= false; end; end; function isAbnfDIGITWideChar(c: wideChar): boolean; begin case word(c) of $0030..$0039: result:= true; else result:= false; end; end; function isAbnfDQUOTEWideChar(c: wideChar): boolean; begin if c = #$22 then result:= true else result:= false; end; function isAbnfHEXDIGWideChar(c: wideChar): boolean; begin case word(c) of $0030..$0039,$0041..$0046: result:= true; else result:= false; end; end; function isAbnfHTABWideChar(c: wideChar): boolean; begin if c = #$09 then result:= true else result:= false; end; function isAbnfLFWideChar(c: wideChar): boolean; begin if c = #$0A then result:= true else result:= false; end; function isAbnfLWSPWideStr(s: wideString): boolean; var i,l: integer; begin l:= length(s); if l = 0 then begin result:= false; exit; end else result:= true; i:= 0; while i < l do begin inc(i); case word(s[i]) of $0020,$0009:; // SP or TAB --> Do nothing, because everthing is alright $000D: begin // CR --> Look for LF if i = l then begin result:= false; exit; end; inc(i); if s[i] <> #$0A then begin result:= false; exit; end; end; else begin result:= false; exit; end; end; end; end; function isAbnfOCTETWideChar(c: wideChar): boolean; begin case word(c) of $0000..$00ff: result:= true; else result:= false; end; end; function isAbnfSPWideChar(c: wideChar): boolean; begin if c = #$20 then result:= true else result:= false; end; function isAbnfVCHARWideChar(c: wideChar): boolean; begin case word(c) of $0021..$007E: result:= true; else result:= false; end; end; function isAbnfWSPWideChar(c: wideChar): boolean; begin case word(c) of $0020,$0009: result:= true; else result:= false; end; end; function isAbnfALPHAChar(c: char): boolean; begin case byte(c) of $41..$5A,$61..$7A: result:= true; else result:= false; end; end; function isAbnfBITChar(c: char): boolean; begin if (c = '0') or (c = '1') then result:= true else result:= false; end; function isAbnfCHARChar(c: char): boolean; begin case byte(c) of $01..$7F: result:= true; else result:= false; end; end; function isAbnfCRChar(c: char): boolean; begin if c = #$0D then result:= true else result:= false; end; function isAbnfCRLFStr(s: string): boolean; begin if s = #$0D#$0A then result:= true else result:= false; end; function isAbnfCTLChar(c: char): boolean; begin case byte(c) of $00..$1F,$7F: result:= true; else result:= false; end; end; function isAbnfDIGITChar(c: char): boolean; begin case byte(c) of $30..$39: result:= true; else result:= false; end; end; function isAbnfDQUOTEChar(c: char): boolean; begin if c = #$22 then result:= true else result:= false; end; function isAbnfHEXDIGChar(c: char): boolean; begin case byte(c) of $30..$39,$41..$46: result:= true; else result:= false; end; end; function isAbnfHTABChar(c: char): boolean; begin if c = #$09 then result:= true else result:= false; end; function isAbnfLFChar(c: char): boolean; begin if c = #$0A then result:= true else result:= false; end; function isAbnfLWSPStr(s: string): boolean; var i,l: integer; begin l:= length(s); if l = 0 then begin result:= false; exit; end else result:= true; i:= 0; while i < l do begin inc(i); case byte(s[i]) of $20,$09:; // SP or TAB --> Do nothing, because everthing is alright $0D: begin // CR --> Look for LF if i = l then begin result:= false; exit; end; inc(i); if s[i] <> #$0A then begin result:= false; exit; end; end; else begin result:= false; exit; end; end; end; end; function isAbnfOCTETChar(c: char): boolean; begin case byte(c) of $00..$ff: result:= true; else result:= false; end; end; function isAbnfSPChar(c: char): boolean; begin if c = #$20 then result:= true else result:= false; end; function isAbnfVCHARChar(c: char): boolean; begin case byte(c) of $21..$7E: result:= true; else result:= false; end; end; function isAbnfWSPChar(c: char): boolean; begin case byte(c) of $20,$09: result:= true; else result:= false; end; end; function isUriURI_referencewideStr(s: wideString): boolean; var dcPos: integer; s1: string; begin dcPos:= pos('#',s); if dcPos > 0 then begin s1:= copy(s,1,dcPos-1); result:= ( isUriAbsoluteURIwideStr(s1) or isUriRelativeURIwideStr(s1) or (s1 = '') ) and isUriFragmentwideStr(copy(s,dcPos+1,length(s)-dcPos)); end else result:= isUriAbsoluteURIwideStr(s) or isUriRelativeURIwideStr(s) or (s = ''); end; function isUriAbsoluteURIwideStr(s: wideString): boolean; var colonPos: integer; s1: string; begin colonPos:= pos(':',s); if colonPos > 0 then begin s1:= copy(s,colonPos+1,length(s)-colonPos); result:= isUriSchemewideStr(copy(s,1,colonPos-1)) and ( isUriHier_partwideStr(s1) or isUriOpaque_partwideStr(s1) ); end else result:= false; end; function isUriRelativeURIwideStr(s: wideString): boolean; var qmPos: integer; s1: string; begin qmPos:= pos(#63,s); if qmPos > 0 then begin s1:= copy(s,1,qmPos-1); result:= ( isUriNet_pathwideStr(s1) or isUriAbs_pathwideStr(s1) or isUriRel_pathwideStr(s1) ) and isUriQuerywideStr(copy(s,qmPos+1,length(s)-qmPos)); end else result:= isUriNet_pathwideStr(s) or isUriAbs_pathwideStr(s) or isUriRel_pathwideStr(s); end; function isUriHier_partwideStr(s: wideString): boolean; var qmPos: integer; s1: string; begin qmPos:= pos(#63,s); if qmPos > 0 then begin s1:= copy(s,1,qmPos-1); result:= ( isUriNet_pathwideStr(s1) or isUriAbs_pathwideStr(s1) ) and isUriQuerywideStr(copy(s,qmPos+1,length(s)-qmPos)); end else result:= isUriNet_pathwideStr(s) or isUriAbs_pathwideStr(s); end; function isUriOpaque_partwideStr(s: wideString): boolean; begin if s = '' then begin result:= false; exit; end; if s[1] = '/' then begin result:= false; exit; end; result:= isUriUricwideStr(s); end; function isUriNet_pathwideStr(s: wideString): boolean; var slashPos: integer; begin if copy(s,1,2) <> '//' then begin result:= false; exit; end; s:= copy(s,3,length(s)-2); slashPos:= pos('/',s); if slashPos > 0 then begin result:= isUriAuthoritywideStr(copy(s,1,slashPos-1)) and isUriAbs_pathwideStr(copy(s,slashPos,length(s)-slashPos+1)); end else result:= isUriAuthoritywideStr(s); end; function isUriAbs_pathwideStr(s: wideString): boolean; begin if s = '' then begin result:= false; exit; end; if s[1] <> '/' then begin result:= false; exit; end; result:= isUriPath_segmentswideStr(copy(s,2,length(s)-1)); end; function isUriRel_pathwideStr(s: wideString): boolean; var slashPos: integer; begin slashPos:= pos('/',s); if slashPos > 0 then begin result:= isUriRel_segmentwideStr(copy(s,1,slashPos-1)) and isUriAbs_pathwideStr(copy(s,slashPos,length(s)-slashPos+1)); end else result:= isUriRel_segmentwideStr(s); end; function isUriRel_segmentwideStr(s: wideString): boolean; var i,l: integer; begin l:= length(s); if l = 0 then begin result:= false; exit; end; result:= true; i:= 0; while i < l do begin inc(i); if s[i] = '%' then begin if i = l then begin result:= false; exit; end; inc(i); if not isUriHexWideChar(s[i]) then begin result:= false; exit; end; if i = l then begin result:= false; exit; end; inc(i); if not isUriHexWideChar(s[i]) then begin result:= false; exit; end; end else if not ( isUriUnreservedWideChar(s[i]) or (s[i] = ';') or (s[i] = '@') or (s[i] = '&') or (s[i] = '=') or (s[i] = '+') or (s[i] = '$') or (s[i] = ',') ) then begin result:= false; exit; end; end; end; function isUriSchemewideStr(s: wideString): boolean; var i,l: integer; begin l:= length(s); if l = 0 then begin result:= false; exit; end; if not isAbnfALPHAWideChar(s[1]) then begin result:= false; exit; end; result:= true; for i:= 2 to l do if not ( isAbnfALPHAWideChar(s[i]) or isAbnfDIGITWideChar(s[i]) or (s[i] = '+') or (s[i] = '-') or (s[i] = '.') ) then begin result:= false; exit; end; end; function isUriAuthoritywideStr(s: wideString): boolean; begin result:= isUriServerwideStr(s) or isUriReg_namewideStr(s); end; function isUriReg_namewideStr(s: wideString): boolean; var i,l: integer; begin l:= length(s); if l = 0 then begin result:= false; exit; end; result:= true; i:= 0; while i < l do begin inc(i); if s[i] = '%' then begin if i = l then begin result:= false; exit; end; inc(i); if not isUriHexWideChar(s[i]) then begin result:= false; exit; end; if i = l then begin result:= false; exit; end; inc(i); if not isUriHexWideChar(s[i]) then begin result:= false; exit; end; end else if not ( isUriUnreservedWideChar(s[i]) or (s[i] = '$') or (s[i] = ',') or (s[i] = ';') or (s[i] = ':') or (s[i] = '@') or (s[i] = '&') or (s[i] = '=') or (s[i] = '+') ) then begin result:= false; exit; end; end; end; function isUriServerwideStr(s: wideString): boolean; var atPos,l: integer; begin l:= length(s); if l = 0 then begin result:= true; exit; end; atPos:= pos('@',s); if atPos > 0 then begin result:= isUriUserinfowideStr(copy(s,1,atPos-1)) and isUriHostportwideStr(copy(s,atPos+1,l-atPos)); end else result:= isUriHostportwideStr(s); end; function isUriUserinfowideStr(s: wideString): boolean; var i,l: integer; begin l:= length(s); result:= true; if l = 0 then exit; i:= 0; while i < l do begin inc(i); if s[i] = '%' then begin if i = l then begin result:= false; exit; end; inc(i); if not isUriHexWideChar(s[i]) then begin result:= false; exit; end; if i = l then begin result:= false; exit; end; inc(i); if not isUriHexWideChar(s[i]) then begin result:= false; exit; end; end else if not ( isUriUnreservedWideChar(s[i]) or (s[i] = ';') or (s[i] = ':') or (s[i] = '&') or (s[i] = '=') or (s[i] = '+') or (s[i] = '$') or (s[i] = ',') ) then begin result:= false; exit; end; end; end; function isUriHostPortwideStr(s: wideString): boolean; var colonPos: integer; begin colonPos:= pos(':',s); if colonPos > 0 then begin result:= isUriHostwideStr(copy(s,1,colonPos-1)) and isUriPortwideStr(copy(s,colonPos+1,length(s)-colonPos)); end else result:= isUriHostwideStr(s); end; function isUriHostwideStr(s: wideString): boolean; begin result:= isUriHostnamewideStr(s) or isUriIPv4addresswideStr(s); end; function isUriHostnamewideStr(s: wideString): boolean; var i,l: integer; begin l:= length(s); if l = 0 then begin result:= false; exit; end; result:= true; if s[l] = '.' then dec(l); i:= l; while i > 0 do begin if s[i] = '.' then break; dec(i); end; if not isUriToplabelwideStr(copy(s,i+1,l-i)) then begin result:= false; exit; end; while i > 0 do begin l:= i; if s[l] = '.' then dec(l); i:= l; while i > 0 do begin if s[i] = '.' then break; dec(i); end; if not isUriDomainlabelwideStr(copy(s,i+1,l-i)) then begin result:= false; exit; end; end; end; function isUriDomainlabelwideStr(s: wideString): boolean; var i,l: integer; begin l:= length(s); if l = 0 then begin result:= false; exit; end; if not ( isUriAlphanumWideChar(s[1]) and isUriAlphanumWideChar(s[l]) ) then begin result:= false; exit; end; result:= true; i:= 1; while i < l do begin inc(i); if not (isUriAlphanumWideChar(s[i]) or (s[i] = '-') ) then begin result:= false; exit; end; end; end; function isUriToplabelwideStr(s: wideString): boolean; var i,l: integer; begin l:= length(s); if l = 0 then begin result:= false; exit; end; if not ( isUriAlphaWideChar(s[1]) and isUriAlphanumWideChar(s[l]) ) then begin result:= false; exit; end; result:= true; i:= 1; while i < l do begin inc(i); if not (isUriAlphanumWideChar(s[i]) or (s[i] = '-') ) then begin result:= false; exit; end; end; end; function isUriIPv4addresswideStr(s: wideString): boolean; var digitNo,colonNo,i,l: integer; digitFound: boolean; begin result:= false; l:= length(s); i:= 0; digitNo:= 0; colonNo:= 0; digitFound:= false; while i < l do begin if isUriDigitWideChar(s[i]) then begin if not digitFound then begin digitFound:= true; inc(digitNo); end; end else if s[i] = '.' then begin if not digitFound then exit; digitFound:= false; inc(colonNo); end else exit; end; if (colonNo = 3) and (digitNo = 4) then result:= true; end; function isUriPortwideStr(s: wideString): boolean; var i,l: integer; begin result:= true; l:= length(s); for i:= 1 to l do if not isUriDigitWideChar(s[i]) then begin result:= false; exit; end; end; function isUriPathwideStr(s: wideString): boolean; begin if isUriAbs_pathwideStr(s) or isUriOpaque_partwideStr(s) or (s = '') then result:= true else result:= false; end; function isUriPath_segmentswideStr(s: wideString): boolean; var i,l: integer; begin l:= length(s); result:= true; if l = 0 then exit; i:= 0; while i < l do begin inc(i); if s[i] = '%' then begin if i = l then begin result:= false; exit; end; inc(i); if not isUriHexWideChar(s[i]) then begin result:= false; exit; end; if i = l then begin result:= false; exit; end; inc(i); if not isUriHexWideChar(s[i]) then begin result:= false; exit; end; end else if not ( isUriUnreservedWideChar(s[i]) or (s[i] = ':') or (s[i] = '@') or (s[i] = '&') or (s[i] = '=') or (s[i] = '+') or (s[i] = '$') or (s[i] = ',') or (s[i] = ';') or (s[i] = '/') ) then begin result:= false; exit; end; end; end; function isUriSegmentwideStr(s: wideString): boolean; var i,l: integer; begin l:= length(s); result:= true; if l = 0 then exit; i:= 0; while i < l do begin inc(i); if s[i] = '%' then begin if i = l then begin result:= false; exit; end; inc(i); if not isUriHexWideChar(s[i]) then begin result:= false; exit; end; if i = l then begin result:= false; exit; end; inc(i); if not isUriHexWideChar(s[i]) then begin result:= false; exit; end; end else if not ( isUriUnreservedWideChar(s[i]) or (s[i] = ':') or (s[i] = '@') or (s[i] = '&') or (s[i] = '=') or (s[i] = '+') or (s[i] = '$') or (s[i] = ',') or (s[i] = ';') ) then begin result:= false; exit; end; end; end; function isUriParamwideStr(s: wideString): boolean; var i,l: integer; begin l:= length(s); result:= true; if l = 0 then exit; i:= 0; while i < l do begin inc(i); if s[i] = '%' then begin if i = l then begin result:= false; exit; end; inc(i); if not isUriHexWideChar(s[i]) then begin result:= false; exit; end; if i = l then begin result:= false; exit; end; inc(i); if not isUriHexWideChar(s[i]) then begin result:= false; exit; end; end else if not ( isUriUnreservedWideChar(s[i]) or (s[i] = ':') or (s[i] = '@') or (s[i] = '&') or (s[i] = '=') or (s[i] = '+') or (s[i] = '$') or (s[i] = ',') ) then begin result:= false; exit; end; end; end; function isUriQuerywideStr(s: wideString): boolean; begin if s = '' then result:= true else result:= isUriUricwideStr(s); end; function isUriFragmentwideStr(s: wideString): boolean; begin if s = '' then result:= true else result:= isUriUricwideStr(s); end; function isUriUricwideStr(s: wideString): boolean; var i,l: integer; begin l:= length(s); if l = 0 then begin result:= false; exit; end else result:= true; i:= 0; while i < l do begin inc(i); if s[i] = '%' then begin if i = l then begin result:= false; exit; end; inc(i); if not isUriHexWideChar(s[i]) then begin result:= false; exit; end; if i = l then begin result:= false; exit; end; inc(i); if not isUriHexWideChar(s[i]) then begin result:= false; exit; end; end else if not ( isUriReservedWideChar(s[i]) or isUriUnreservedWideChar(s[i]) ) then begin result:= false; exit; end; end; end; function isUriReservedWideChar(c: wideChar): boolean; begin if (c=';') or (c='/') or (c=#63) or (c=':') or (c='@') or (c='&') or (c='=') or (c='+') or (c='$') or (c=',') then result:= true else result:= false; end; function isUriUnreservedWideChar(c: wideChar): boolean; begin if isUriAlphanumWideChar(c) or isUriMarkWideChar(c) then result:= true else result:= false; end; function isUriMarkWideChar(c: wideChar): boolean; begin if (c='-') or (c='_') or (c='.') or (c='!') or (c='~') or (c='*') or (c=#39) or (c='(') or (c=')') then result:= true else result:= false; end; function isUriHexWideChar(c: wideChar): boolean; begin case word(c) of $0030..$0039,$0041..$0046,$0061..$0066: // 0..9 , A..F , a..f result:= true; else result:= false; end; end; function isUriAlphanumWideChar(c: wideChar): boolean; begin case word(c) of $0030..$0039,$0041..$005A,$0061..$007A: result:= true; else result:= false; end; end; function isUriAlphaWideChar(c: wideChar): boolean; begin case word(c) of $0041..$005A,$0061..$007A: result:= true; else result:= false; end; end; function isUriDigitWideChar(c: wideChar): boolean; begin case word(c) of $0030..$0039: result:= true; else result:= false; end; end; function isUriURI_referenceStr(s: string): boolean; var dcPos: integer; s1: string; begin dcPos:= pos('#',s); if dcPos > 0 then begin s1:= copy(s,1,dcPos-1); result:= ( isUriAbsoluteURIStr(s1) or isUriRelativeURIStr(s1) or (s1 = '') ) and isUriFragmentStr(copy(s,dcPos+1,length(s)-dcPos)); end else result:= isUriAbsoluteURIStr(s) or isUriRelativeURIStr(s) or (s = ''); end; function isUriAbsoluteURIStr(s: string): boolean; var colonPos: integer; s1: string; begin colonPos:= pos(':',s); if colonPos > 0 then begin s1:= copy(s,colonPos+1,length(s)-colonPos); result:= isUriSchemeStr(copy(s,1,colonPos-1)) and ( isUriHier_partStr(s1) or isUriOpaque_partStr(s1) ); end else result:= false; end; function isUriRelativeURIStr(s: string): boolean; var qmPos: integer; s1: string; begin qmPos:= pos('?',s); if qmPos > 0 then begin s1:= copy(s,1,qmPos-1); result:= ( isUriNet_pathStr(s1) or isUriAbs_pathStr(s1) or isUriRel_pathStr(s1) ) and isUriQueryStr(copy(s,qmPos+1,length(s)-qmPos)); end else result:= isUriNet_pathStr(s) or isUriAbs_pathStr(s) or isUriRel_pathStr(s); end; function isUriHier_partStr(s: string): boolean; var qmPos: integer; s1: string; begin qmPos:= pos('?',s); if qmPos > 0 then begin s1:= copy(s,1,qmPos-1); result:= ( isUriNet_pathStr(s1) or isUriAbs_pathStr(s1) ) and isUriQueryStr(copy(s,qmPos+1,length(s)-qmPos)); end else result:= isUriNet_pathStr(s) or isUriAbs_pathStr(s); end; function isUriOpaque_partStr(s: string): boolean; begin if s = '' then begin result:= false; exit; end; if s[1] = '/' then begin result:= false; exit; end; result:= isUriUricStr(s); end; function isUriNet_pathStr(s: string): boolean; var slashPos: integer; begin if copy(s,1,2) <> '//' then begin result:= false; exit; end; s:= copy(s,3,length(s)-2); slashPos:= pos('/',s); if slashPos > 0 then begin result:= isUriAuthorityStr(copy(s,1,slashPos-1)) and isUriAbs_pathStr(copy(s,slashPos,length(s)-slashPos+1)); end else result:= isUriAuthorityStr(s); end; function isUriAbs_pathStr(s: string): boolean; begin if s = '' then begin result:= false; exit; end; if s[1] <> '/' then begin result:= false; exit; end; result:= isUriPath_segmentsStr(copy(s,2,length(s)-1)); end; function isUriRel_pathStr(s: string): boolean; var slashPos: integer; begin slashPos:= pos('/',s); if slashPos > 0 then begin result:= isUriRel_segmentStr(copy(s,1,slashPos-1)) and isUriAbs_pathStr(copy(s,slashPos,length(s)-slashPos+1)); end else result:= isUriRel_segmentStr(s); end; function isUriRel_segmentStr(s: string): boolean; var i,l: integer; begin l:= length(s); if l = 0 then begin result:= false; exit; end; result:= true; i:= 0; while i < l do begin inc(i); if s[i] = '%' then begin if i = l then begin result:= false; exit; end; inc(i); if not isUriHexChar(s[i]) then begin result:= false; exit; end; if i = l then begin result:= false; exit; end; inc(i); if not isUriHexChar(s[i]) then begin result:= false; exit; end; end else if not ( isUriUnreservedChar(s[i]) or (s[i] = ';') or (s[i] = '@') or (s[i] = '&') or (s[i] = '=') or (s[i] = '+') or (s[i] = '$') or (s[i] = ',') ) then begin result:= false; exit; end; end; end; function isUriSchemeStr(s: string): boolean; var i,l: integer; begin l:= length(s); if l = 0 then begin result:= false; exit; end; if not isAbnfALPHAChar(s[1]) then begin result:= false; exit; end; result:= true; for i:= 2 to l do if not ( isAbnfALPHAChar(s[i]) or isAbnfDIGITChar(s[i]) or (s[i] = '+') or (s[i] = '-') or (s[i] = '.') ) then begin result:= false; exit; end; end; function isUriAuthorityStr(s: string): boolean; begin result:= isUriServerStr(s) or isUriReg_nameStr(s); end; function isUriReg_nameStr(s: string): boolean; var i,l: integer; begin l:= length(s); if l = 0 then begin result:= false; exit; end; result:= true; i:= 0; while i < l do begin inc(i); if s[i] = '%' then begin if i = l then begin result:= false; exit; end; inc(i); if not isUriHexChar(s[i]) then begin result:= false; exit; end; if i = l then begin result:= false; exit; end; inc(i); if not isUriHexChar(s[i]) then begin result:= false; exit; end; end else if not ( isUriUnreservedChar(s[i]) or (s[i] = '$') or (s[i] = ',') or (s[i] = ';') or (s[i] = ':') or (s[i] = '@') or (s[i] = '&') or (s[i] = '=') or (s[i] = '+') ) then begin result:= false; exit; end; end; end; function isUriServerStr(s: string): boolean; var atPos,l: integer; begin l:= length(s); if l = 0 then begin result:= true; exit; end; atPos:= pos('@',s); if atPos > 0 then begin result:= isUriUserinfoStr(copy(s,1,atPos-1)) and isUriHostportStr(copy(s,atPos+1,l-atPos)); end else result:= isUriHostportStr(s); end; function isUriUserinfoStr(s: string): boolean; var i,l: integer; begin l:= length(s); result:= true; if l = 0 then exit; i:= 0; while i < l do begin inc(i); if s[i] = '%' then begin if i = l then begin result:= false; exit; end; inc(i); if not isUriHexChar(s[i]) then begin result:= false; exit; end; if i = l then begin result:= false; exit; end; inc(i); if not isUriHexChar(s[i]) then begin result:= false; exit; end; end else if not ( isUriUnreservedChar(s[i]) or (s[i] = ';') or (s[i] = ':') or (s[i] = '&') or (s[i] = '=') or (s[i] = '+') or (s[i] = '$') or (s[i] = ',') ) then begin result:= false; exit; end; end; end; function isUriHostPortStr(s: string): boolean; var colonPos: integer; begin colonPos:= pos(':',s); if colonPos > 0 then begin result:= isUriHostStr(copy(s,1,colonPos-1)) and isUriPortStr(copy(s,colonPos+1,length(s)-colonPos)); end else result:= isUriHostStr(s); end; function isUriHostStr(s: string): boolean; begin result:= isUriHostnameStr(s) or isUriIPv4addressStr(s); end; function isUriHostnameStr(s: string): boolean; var i,l: integer; begin l:= length(s); if l = 0 then begin result:= false; exit; end; result:= true; if s[l] = '.' then dec(l); i:= l; while i > 0 do begin if s[i] = '.' then break; dec(i); end; if not isUriToplabelStr(copy(s,i+1,l-i)) then begin result:= false; exit; end; while i > 0 do begin l:= i; if s[l] = '.' then dec(l); i:= l; while i > 0 do begin if s[i] = '.' then break; dec(i); end; if not isUriDomainlabelStr(copy(s,i+1,l-i)) then begin result:= false; exit; end; end; end; function isUriDomainlabelStr(s: string): boolean; var i,l: integer; begin l:= length(s); if l = 0 then begin result:= false; exit; end; if not ( isUriAlphanumChar(s[1]) and isUriAlphanumChar(s[l]) ) then begin result:= false; exit; end; result:= true; i:= 1; while i < l do begin inc(i); if not (isUriAlphanumChar(s[i]) or (s[i] = '-') ) then begin result:= false; exit; end; end; end; function isUriToplabelStr(s: string): boolean; var i,l: integer; begin l:= length(s); if l = 0 then begin result:= false; exit; end; if not ( isUriAlphaChar(s[1]) and isUriAlphanumChar(s[l]) ) then begin result:= false; exit; end; result:= true; i:= 1; while i < l do begin inc(i); if not (isUriAlphanumChar(s[i]) or (s[i] = '-') ) then begin result:= false; exit; end; end; end; function isUriIPv4addressStr(s: string): boolean; var digitNo,colonNo,i,l: integer; digitFound: boolean; begin result:= false; l:= length(s); i:= 0; digitNo:= 0; colonNo:= 0; digitFound:= false; while i < l do begin if isUriDigitChar(s[i]) then begin if not digitFound then begin digitFound:= true; inc(digitNo); end; end else if s[i] = '.' then begin if not digitFound then exit; digitFound:= false; inc(colonNo); end else exit; end; if (colonNo = 3) and (digitNo = 4) then result:= true; end; function isUriPortStr(s: string): boolean; var i,l: integer; begin result:= true; l:= length(s); for i:= 1 to l do if not isUriDigitChar(s[i]) then begin result:= false; exit; end; end; function isUriPathStr(s: string): boolean; begin if isUriAbs_pathStr(s) or isUriOpaque_partStr(s) or (s = '') then result:= true else result:= false; end; function isUriPath_segmentsStr(s: string): boolean; var i,l: integer; begin l:= length(s); result:= true; if l = 0 then exit; i:= 0; while i < l do begin inc(i); if s[i] = '%' then begin if i = l then begin result:= false; exit; end; inc(i); if not isUriHexChar(s[i]) then begin result:= false; exit; end; if i = l then begin result:= false; exit; end; inc(i); if not isUriHexChar(s[i]) then begin result:= false; exit; end; end else if not ( isUriUnreservedChar(s[i]) or (s[i] = ':') or (s[i] = '@') or (s[i] = '&') or (s[i] = '=') or (s[i] = '+') or (s[i] = '$') or (s[i] = ',') or (s[i] = ';') or (s[i] = '/') ) then begin result:= false; exit; end; end; end; function isUriSegmentStr(s: string): boolean; var i,l: integer; begin l:= length(s); result:= true; if l = 0 then exit; i:= 0; while i < l do begin inc(i); if s[i] = '%' then begin if i = l then begin result:= false; exit; end; inc(i); if not isUriHexChar(s[i]) then begin result:= false; exit; end; if i = l then begin result:= false; exit; end; inc(i); if not isUriHexChar(s[i]) then begin result:= false; exit; end; end else if not ( isUriUnreservedChar(s[i]) or (s[i] = ':') or (s[i] = '@') or (s[i] = '&') or (s[i] = '=') or (s[i] = '+') or (s[i] = '$') or (s[i] = ',') or (s[i] = ';') ) then begin result:= false; exit; end; end; end; function isUriParamStr(s: string): boolean; var i,l: integer; begin l:= length(s); result:= true; if l = 0 then exit; i:= 0; while i < l do begin inc(i); if s[i] = '%' then begin if i = l then begin result:= false; exit; end; inc(i); if not isUriHexChar(s[i]) then begin result:= false; exit; end; if i = l then begin result:= false; exit; end; inc(i); if not isUriHexChar(s[i]) then begin result:= false; exit; end; end else if not ( isUriUnreservedChar(s[i]) or (s[i] = ':') or (s[i] = '@') or (s[i] = '&') or (s[i] = '=') or (s[i] = '+') or (s[i] = '$') or (s[i] = ',') ) then begin result:= false; exit; end; end; end; function isUriQueryStr(s: string): boolean; begin if s = '' then result:= true else result:= isUriUricStr(s); end; function isUriFragmentStr(s: string): boolean; begin if s = '' then result:= true else result:= isUriUricStr(s); end; function isUriUricStr(s: string): boolean; var i,l: integer; begin l:= length(s); if l = 0 then begin result:= false; exit; end else result:= true; i:= 0; while i < l do begin inc(i); if s[i] = '%' then begin if i = l then begin result:= false; exit; end; inc(i); if not isUriHexChar(s[i]) then begin result:= false; exit; end; if i = l then begin result:= false; exit; end; inc(i); if not isUriHexChar(s[i]) then begin result:= false; exit; end; end else if not ( isUriReservedChar(s[i]) or isUriUnreservedChar(s[i]) ) then begin result:= false; exit; end; end; end; function isUriReservedChar(c: char): boolean; begin if (c=';') or (c='/') or (c='?') or (c=':') or (c='@') or (c='&') or (c='=') or (c='+') or (c='$') or (c=',') then result:= true else result:= false; end; function isUriUnreservedChar(c: char): boolean; begin if isUriAlphanumChar(c) or isUriMarkChar(c) then result:= true else result:= false; end; function isUriMarkChar(c: char): boolean; begin if (c='-') or (c='_') or (c='.') or (c='!') or (c='~') or (c='*') or (c=#39) or (c='(') or (c=')') then result:= true else result:= false; end; function isUriHexChar(c: char): boolean; begin case byte(c) of $30..$39,$41..$46,$61..$66: // 0..9 , A..F , a..f result:= true; else result:= false; end; end; function isUriAlphanumChar(c: char): boolean; begin case byte(c) of $30..$39,$41..$5A,$61..$7A: result:= true; else result:= false; end; end; function isUriAlphaChar(c: char): boolean; begin case byte(c) of $41..$5A,$61..$7A: result:= true; else result:= false; end; end; function isUriDigitChar(c: char): boolean; begin case byte(c) of $30..$39: result:= true; else result:= false; end; end; function resolveRelativeUriStr(const baseUri, relUri: string; var resultUri: string): boolean; var BaseUriAnalyzer,RelUriAnalyzer: TUriStrAnalyzer; i,slashPos,queryIndex: integer; pathBuffer: string; segments: TStringList; begin resultUri:= ''; BaseUriAnalyzer:= TUriStrAnalyzer.create; RelUriAnalyzer:= TUriStrAnalyzer.create; try result:= BaseUriAnalyzer.setUriReference(baseUri); result:= (RelUriAnalyzer.setUriReference(relUri) and result); result:= ((BaseUriAnalyzer.HasUriScheme or RelUriAnalyzer.HasUriScheme) and result); if not result then exit; // baseUri is not an absolute URI reference, or baseUri or relUri is maleformed with RelUriAnalyzer do begin if (UriPath = '') and not ( HasUriScheme or HasUriAuthority or HasUriQuery) then begin // Same document reference detected BaseUriAnalyzer.setUriFragment(UriFragment,HasUriFragment); resultUri:= BaseUriAnalyzer.UriReference; exit; end; if HasUriScheme then begin // relUri is an absolute URI --> we are done. resultUri:= relUri; exit; end; // inherit scheme: setUriScheme(BaseUriAnalyzer.UriScheme,BaseUriAnalyzer.HasUriScheme); if not HasUriAuthority then begin // inherit authority: setUriAuthority(BaseUriAnalyzer.UriAuthority,BaseUriAnalyzer.HasUriAuthority); if not (copy(UriPath,1,1) = '/') then begin // analyze paths: segments:= TStringList.create; try slashPos:= LastDelimiter('/',BaseUriAnalyzer.UriPath); if slashPos > 0 then pathBuffer:= copy(BaseUriAnalyzer.UriPath,2,slashPos-1) // Copy path without last segment and first character which is always '/' else pathBuffer:= ''; pathBuffer:= concat(pathBuffer,UriPath); with segments do begin // cut pathBuffer into segments: slashPos:= pos('/',pathBuffer); while slashPos > 0 do begin Add(copy(pathBuffer,1,slashPos-1)); pathBuffer:= copy(pathBuffer,slashPos+1,length(pathBuffer)-slashPos); slashPos:= pos('/',pathBuffer); end; {while ...} Add(pathBuffer); if (pathBuffer = '..') or (pathBuffer = '.') then Add(''); // Necessary to preserve ending '/' under some circumstances // remove '.' segments: queryIndex:= IndexOf('.'); while queryIndex > -1 do begin Delete(queryIndex); queryIndex:= IndexOf('.'); end; // remove '/..' segments: queryIndex:= IndexOf('..'); while queryIndex > 0 do begin Delete(queryIndex); Delete(pred(queryIndex)); queryIndex:= IndexOf('..'); end; // test for maleformed path: if count > 0 then if strings[0] = '..' then begin result:= false; exit; end; pathBuffer:= ''; for i:= 0 to pred(count) do pathBuffer:= concat(pathBuffer,'/',strings[i]); setUriPath(pathBuffer); end; {with segments ...} finally segments.free; end; end; {if not (copy(UriPath,1,1) = '/') ...} end; {if not HasAuthorityScheme ...} resultUri:= UriReference; end; {with RelUriAnalyzer ...} finally BaseUriAnalyzer.free; RelUriAnalyzer.free; end; end; function resolveRelativeUriWideStr(const baseUri, relUri: wideString; var resultUri: wideString): boolean; var BaseUriAnalyzer,RelUriAnalyzer: TUriWideStrAnalyzer; i,slashPos,queryIndex: integer; pathBuffer: wideString; segments: TdomWideStringList; begin resultUri:= ''; BaseUriAnalyzer:= TUriWideStrAnalyzer.create; RelUriAnalyzer:= TUriWideStrAnalyzer.create; try result:= BaseUriAnalyzer.setUriReference(baseUri); result:= (RelUriAnalyzer.setUriReference(relUri) and result); result:= ( (BaseUriAnalyzer.HasUriScheme or RelUriAnalyzer.HasUriScheme) and result); if not result then exit; // baseUri is not an absolute URI reference, or baseUri or relUri is maleformed with RelUriAnalyzer do begin if (UriPath = '') and not ( HasUriScheme or HasUriAuthority or HasUriQuery) then begin // Same document reference detected BaseUriAnalyzer.setUriFragment(UriFragment,HasUriFragment); resultUri:= BaseUriAnalyzer.UriReference; exit; end; if HasUriScheme then begin // relUri is an absolute URI --> we are done. resultUri:= relUri; exit; end; // inherit scheme: setUriScheme(BaseUriAnalyzer.UriScheme,BaseUriAnalyzer.HasUriScheme); if not HasUriAuthority then begin // inherit authority: setUriAuthority(BaseUriAnalyzer.UriAuthority,BaseUriAnalyzer.HasUriAuthority); if not (copy(UriPath,1,1) = '/') then begin // analyze paths: segments:= TdomWideStringList.create; try slashPos:= LastDelimiter('/',BaseUriAnalyzer.UriPath); if slashPos > 0 then pathBuffer:= copy(BaseUriAnalyzer.UriPath,2,slashPos-1) // Copy path without last segment and first character which is always '/' else pathBuffer:= ''; pathBuffer:= concat(pathBuffer,UriPath); with segments do begin // cut pathBuffer into segments: slashPos:= pos('/',pathBuffer); while slashPos > 0 do begin Add(copy(pathBuffer,1,slashPos-1)); pathBuffer:= copy(pathBuffer,slashPos+1,length(pathBuffer)-slashPos); slashPos:= pos('/',pathBuffer); end; {while ...} Add(pathBuffer); if (pathBuffer = '..') or (pathBuffer = '.') then Add(''); // Necessary to preserve ending '/' under some circumstances // remove '.' segments: queryIndex:= IndexOf('.'); while queryIndex > -1 do begin Delete(queryIndex); queryIndex:= IndexOf('.'); end; // remove '/..' segments: queryIndex:= IndexOf('..'); while queryIndex > 0 do begin Delete(queryIndex); Delete(pred(queryIndex)); queryIndex:= IndexOf('..'); end; // test for maleformed path: if count > 0 then if wideStrings[0] = '..' then begin result:= false; exit; end; pathBuffer:= ''; for i:= 0 to pred(count) do pathBuffer:= concat(pathBuffer,'/',wideStrings[i]); setUriPath(pathBuffer); end; {with segments ...} finally segments.free; end; end; {if not (copy(UriPath,1,1) = '/') ...} end; {if not HasAuthorityScheme ...} resultUri:= UriReference; end; {with RelUriAnalyzer ...} finally BaseUriAnalyzer.free; RelUriAnalyzer.free; end; end; function FilenameToUriStr(const path: TFilename; const opt: TdomFilenameToUriOptions): string; var i,l: integer; begin if fuSetLocalhost in opt then result:= 'file://localhost' else result:= 'file://'; l:= length(path); if l > 0 then begin // add leading '/': result:= concat(result,'/'); i:= 1; while i <= l do begin case byte(path[i]) of // A-z a-z 0-9 ! '()* - . _ ~ $41..$5A,$61..$7A,$30..$39,$21,$27..$2a,$2d,$2e,$5f,$7e: result:= concat(result,path[i]); // special treatment for colons (':'): $3a: if fuPlainColon in opt then result:= concat(result,':') else result:= concat(result,'%3a'); // translate '\' to '/': $5c: result:= concat(result,'/'); else // calculate escape sequence: result:= concat(result,'%',IntToHex(byte(path[i]),2)); end; inc(i); end; {while ...} end; {if ...} end; function FilenameToUriWideStr(const path: TFilename; const opt: TdomFilenameToUriOptions): wideString; var i,l: integer; begin if fuSetLocalhost in opt then result:= 'file://localhost' else result:= 'file://'; l:= length(path); if l > 0 then begin // add leading '/': result:= concat(result,'/'); i:= 1; while i <= l do begin case byte(path[i]) of // A-z a-z 0-9 ! '()* - . _ ~ $41..$5A,$61..$7A,$30..$39,$21,$27..$2a,$2d,$2e,$5f,$7e: result:= concat(result,wideString(wideChar(byte(path[i])))); // special treatment for colons (':'): $3a: if fuPlainColon in opt then result:= concat(result,':') else result:= concat(result,'%3a'); // translate '\' to '/': $5c: result:= concat(result,'/'); else // calculate escape sequence: result:= concat(result,'%',IntToHex(byte(path[i]),2)); end; inc(i); end; {while ...} end; {if ...} end; function UriStrToFilename(const uri: string; var path: TFilename; var authority, query, fragment: string): boolean; var UriAnalyzer: TUriStrAnalyzer; pathBuffer: string; // Used to increase performance i,l: integer; begin path:= ''; query:= ''; fragment:= ''; result:= false; UriAnalyzer:= TUriStrAnalyzer.create; try with UriAnalyzer do begin if setUriReference(uri) then begin if CompareText(UriScheme,'file') = 0 then begin result:= true; pathBuffer:= UriPath; l:= length(pathBuffer); if l > 0 then begin // remove leading '/': dec(l); pathBuffer:= copy(pathBuffer,2,l); i:= 1; while i <= l do begin if pathBuffer[i] = '%' then begin // resolve escape sequence: path:= concat(path,chr(StrToInt(concat('x',pathBuffer[i+1],pathBuffer[i+2])))); i:= i+2; end else if pathBuffer[i] = '/' then begin // translate '/' to '\': path:= concat(path,'\'); end else path:= concat(path,pathBuffer[i]); inc(i); end; {while ...} end; {if ...} authority:= UriAuthority; if HasUriQuery then query:= concat('?',UriQuery); if HasUriFragment then fragment:= concat('#',UriFragment); end; {if ...} end; {if ...} end; {with ...} finally UriAnalyzer.free; end; end; function UriWideStrToFilename(const uri: wideString; var path: TFilename; var authority, query, fragment: string): boolean; var UriAnalyzer: TUriStrAnalyzer; pathBuffer: string; // Used to increase performance uri2: string; i,l: integer; begin path:= ''; query:= ''; fragment:= ''; result:= false; try uri2:= UTF16To7BitASCIIStr(uri) except uri2:= ''; end; UriAnalyzer:= TUriStrAnalyzer.create; try with UriAnalyzer do begin if setUriReference(uri2) then begin if CompareText(UriScheme,'file') = 0 then begin result:= true; pathBuffer:= UriPath; l:= length(pathBuffer); if l > 0 then begin // remove leading '/': dec(l); pathBuffer:= copy(pathBuffer,2,l); i:= 1; while i <= l do begin if pathBuffer[i] = '%' then begin // resolve escape sequence: path:= concat(path,chr(StrToInt(concat('x',pathBuffer[i+1],pathBuffer[i+2])))); i:= i+2; end else if pathBuffer[i] = '/' then begin // translate '/' to '\': path:= concat(path,'\'); end else path:= concat(path,pathBuffer[i]); inc(i); end; {while ...} end; {if ...} authority:= UriAuthority; if HasUriQuery then query:= concat('?',UriQuery); if HasUriFragment then fragment:= concat('#',UriFragment); end; {if ...} end; {if ...} end; {with ...} finally UriAnalyzer.free; end; end; procedure writeWideChars(stream: TStream; const XMLChars: array of WideChar); begin stream.WriteBuffer(XMLChars, SizeOf(XMLChars)); end; procedure writeWideString(stream: TStream; const XMLStrg: wideString); begin stream.WriteBuffer(pointer(XMLStrg)^, Length(XMLStrg) shl 1); end; procedure writeWideStrings(stream: TStream; const XMLStrgs: array of wideString); var Indx: longint; begin for Indx := 0 to High(XMLStrgs) do stream.WriteBuffer(pointer(XMLStrgs[Indx])^, Length(XMLStrgs[Indx]) shl 1); end; function XPathBooleanFunc(const oldResult: TdomXPathResult): TdomXPathBooleanResult; begin if not assigned(oldResult) then raise ENot_Supported_Err.create('Not supported error.'); case oldResult.resultType of XPATH_NUMBER_TYPE: begin if TdomXPathNumberResult(oldResult).numberValue = 0 then begin // xxx NaN ? oldResult.free; result:= TdomXPathBooleanResult.create(false); end else begin oldResult.free; result:= TdomXPathBooleanResult.create(true); end; end; XPATH_NODE_SNAPSHOT_TYPE: begin if TdomXPathSnapshotResult(oldResult).snapshotLength > 0 then begin oldResult.free; result:= TdomXPathBooleanResult.create(true); end else begin oldResult.free; result:= TdomXPathBooleanResult.create(false); end; end; XPATH_STRING_TYPE: begin if length(TdomXPathStringResult(oldResult).stringValue) > 0 then begin oldResult.free; result:= TdomXPathBooleanResult.create(true); end else begin oldResult.free; result:= TdomXPathBooleanResult.create(false); end; end; XPATH_BOOLEAN_TYPE: result:= (oldResult as TdomXPathBooleanResult); else oldResult.free; raise ENot_Supported_Err.create('Not supported error.'); end; end; function XPathNumberFunc(const oldResult: TdomXPathResult): TdomXPathNumberResult; var stringResult: TdomXPathStringResult; function convertXPathStringType(const oldResult: TdomXPathStringResult): TdomXPathNumberResult; begin try result:= TdomXPathNumberResult.create(StrToFloat(oldResult.stringValue)); except result:= TdomXPathNumberResult.create(0); // xxx Not XPath conformant, because we must use NaN. end; oldResult.free; end; begin if not assigned(oldResult) then raise ENot_Supported_Err.create('Not supported error.'); case oldResult.resultType of XPATH_NUMBER_TYPE: result:= (oldResult as TdomXPathNumberResult); XPATH_NODE_SNAPSHOT_TYPE: begin stringResult:= XPathStringFunc(oldResult); result:= convertXPathStringType(stringResult); end; XPATH_STRING_TYPE: result:= convertXPathStringType(TdomXPathStringResult(oldResult)); XPATH_BOOLEAN_TYPE: begin if TdomXPathBooleanResult(oldResult).booleanValue then result:= TdomXPathNumberResult.create(1) else result:= TdomXPathNumberResult.create(0); oldResult.free; end; else oldResult.free; raise ENot_Supported_Err.create('Not supported error.'); end; end; function XPathStringFunc(const oldResult: TdomXPathResult): TdomXPathStringResult; begin if not assigned(oldResult) then raise ENot_Supported_Err.create('Not supported error.'); case oldResult.resultType of XPATH_NUMBER_TYPE: begin result:= TdomXPathStringResult.create(FloatToStr(TdomXPathNumberResult(oldResult).numberValue)); // xxx Not XPath conformant, because FloatToStr uses limited digits. oldResult.free; end; XPATH_NODE_SNAPSHOT_TYPE: begin if TdomXPathSnapshotResult(oldResult).snapshotLength = 0 then begin result:= TdomXPathStringResult.create(''); oldResult.free; end else begin result:= TdomXPathStringResult.create(TdomXPathSnapshotResult(oldResult).snapshotItem(0).XPathStringValue); oldResult.free; end; end; XPATH_STRING_TYPE: result:= (oldResult as TdomXPathStringResult); XPATH_BOOLEAN_TYPE: begin if TdomXPathBooleanResult(oldResult).booleanValue then result:= TdomXPathStringResult.create('true') else result:= TdomXPathStringResult.create('false'); oldResult.free; end; else oldResult.free; raise ENot_Supported_Err.create('Not supported error.'); end; end; // ++++++++++++++++++++++++++ TUriStrAnalyzer +++++++++++++++++++++++++++ constructor TUriStrAnalyzer.create; begin setUriReference(''); end; function TUriStrAnalyzer.getUriReference: string; begin result:= ''; if FHasUriScheme then result:= concat(result,FUriScheme,':'); if FHasUriAuthority then result:= concat(result,'//',FUriAuthority); result:= concat(result,FUriPath); if FHasUriQuery then result:= concat(result,'?',FUriQuery); if FHasUriFragment then result:= concat(result,'#',FUriFragment); end; function TUriStrAnalyzer.setUriAuthority(const Value: string; const isDefined: boolean): boolean; begin result:= true; FHasUriAuthority:= isDefined; if isDefined then begin if isUriAuthorityStr(Value) then FUriAuthority:= value else begin FUriAuthority:= ''; result:= false; end; end else FUriAuthority:= ''; end; function TUriStrAnalyzer.setUriFragment(const Value: string; const isDefined: boolean): boolean; begin result:= true; FHasUriFragment:= isDefined; if isDefined then begin if isUriFragmentStr(Value) then FUriFragment:= value else begin FUriFragment:= ''; result:= false; end; end else FUriFragment:= ''; end; function TUriStrAnalyzer.setUriPath(const Value: string): boolean; begin result:= isUriPathStr(Value); if result then FUriPath:= value else FUriPath:= ''; end; function TUriStrAnalyzer.setUriQuery(const Value: string; const isDefined: boolean): boolean; begin result:= true; FHasUriQuery:= isDefined; if isDefined then begin if isUriQueryStr(Value) then FUriQuery:= value else begin FUriQuery:= ''; result:= false; end; end else FUriQuery:= ''; end; function TUriStrAnalyzer.setUriReference(const Value: string): boolean; var colonPos,dcPos,qmPos,slashPos: integer; s: string; begin colonPos:= pos(':',value); result:= setUriScheme(copy(value,1,colonPos-1),(colonPos > 0)); s:= copy(value,colonPos+1,length(value)-colonPos); dcPos:= pos('#',s); if dcPos > 0 then begin result:= (setUriFragment(copy(s,dcPos+1,length(s)-dcPos),true) and result); s:= copy(s,1,dcPos-1); end else setUriFragment('',false); qmPos:= pos('?',s); if qmPos > 0 then begin result:= (setUriQuery(copy(s,qmPos+1,length(s)-qmPos),true) and result); s:= copy(s,1,qmPos-1); end else setUriQuery('',false); if copy(s,1,2) = '//' then begin s:= copy(s,3,length(s)-2); slashPos:= pos('/',s); if slashPos > 0 then begin result:= (setUriAuthority(copy(s,1,slashPos-1),true) and result); s:= copy(s,slashPos,length(s)-slashPos+1); end else begin result:= (setUriAuthority(s,true) and result); s:= ''; end; end else setUriAuthority('',false); result:= setUriPath(s) and result; if not result then setUriReference(''); end; function TUriStrAnalyzer.setUriScheme(const Value: string; const isDefined: boolean): boolean; begin result:= true; FHasUriScheme:= isDefined; if isDefined then begin if isUriSchemeStr(Value) then FUriScheme:= value else begin FUriScheme:= ''; result:= false; end; end else FUriScheme:= ''; end; // ++++++++++++++++++++++++ TUriWideStrAnalyzer +++++++++++++++++++++++++ constructor TUriWideStrAnalyzer.create; begin setUriReference(''); end; function TUriWideStrAnalyzer.getUriReference: wideString; begin result:= ''; if FHasUriScheme then result:= concat(result,FUriScheme,':'); if FHasUriAuthority then result:= concat(result,'//',FUriAuthority); result:= concat(result,FUriPath); if FHasUriQuery then result:= concat(result,#63,FUriQuery); if FHasUriFragment then result:= concat(result,'#',FUriFragment); end; function TUriWideStrAnalyzer.setUriAuthority(const Value: wideString; const isDefined: boolean): boolean; begin result:= true; FHasUriAuthority:= isDefined; if isDefined then begin if isUriAuthorityWideStr(Value) then FUriAuthority:= value else begin FUriAuthority:= ''; result:= false; end; end else FUriAuthority:= ''; end; function TUriWideStrAnalyzer.setUriFragment(const Value: wideString; const isDefined: boolean): boolean; begin result:= true; FHasUriFragment:= isDefined; if isDefined then begin if isUriFragmentWideStr(Value) then FUriFragment:= value else begin FUriFragment:= ''; result:= false; end; end else FUriFragment:= ''; end; function TUriWideStrAnalyzer.setUriPath(const Value: wideString): boolean; begin result:= isUriPathWideStr(Value); if result then FUriPath:= value else FUriPath:= ''; end; function TUriWideStrAnalyzer.setUriQuery(const Value: wideString; const isDefined: boolean): boolean; begin result:= true; FHasUriQuery:= isDefined; if isDefined then begin if isUriQueryWideStr(Value) then FUriQuery:= value else begin FUriQuery:= ''; result:= false; end; end else FUriQuery:= ''; end; function TUriWideStrAnalyzer.setUriReference(const Value: wideString): boolean; var colonPos,dcPos,qmPos,slashPos: integer; s: wideString; begin colonPos:= pos(':',value); result:= setUriScheme(copy(value,1,colonPos-1),(colonPos > 0)); s:= copy(value,colonPos+1,length(value)-colonPos); dcPos:= pos('#',s); if dcPos > 0 then begin result:= (setUriFragment(copy(s,dcPos+1,length(s)-dcPos),true) and result); s:= copy(s,1,dcPos-1); end else setUriFragment('',false); qmPos:= pos('?',s); if qmPos > 0 then begin result:= (setUriQuery(copy(s,qmPos+1,length(s)-qmPos),true) and result); s:= copy(s,1,qmPos-1); end else setUriQuery('',false); if copy(s,1,2) = '//' then begin s:= copy(s,3,length(s)-2); slashPos:= pos('/',s); if slashPos > 0 then begin result:= (setUriAuthority(copy(s,1,slashPos-1),true) and result); s:= copy(s,slashPos,length(s)-slashPos+1); end else begin result:= (setUriAuthority(s,true) and result); s:= ''; end; end else setUriAuthority('',false); result:= setUriPath(s) and result; if not result then setUriReference(''); end; function TUriWideStrAnalyzer.setUriScheme(const Value: wideString; const isDefined: boolean): boolean; begin result:= true; FHasUriScheme:= isDefined; if isDefined then begin if isUriSchemeWideStr(Value) then FUriScheme:= value else begin FUriScheme:= ''; result:= false; end; end else FUriScheme:= ''; end; // +++++++++++++++++++++++++ TdomNameValueList +++++++++++++++++++++++++ constructor TdomNameValueList.create; begin inherited create; FNames:= TdomWideStringList.create; FValues:= TdomWideStringList.create; end; destructor TdomNameValueList.destroy; begin FNames.free; FValues.free; inherited destroy; end; procedure TdomNameValueList.error(const msg: string; data: integer); {$IFNDEF FPC} function ReturnAddr: Pointer; asm MOV EAX,[EBP+4] end; {$ENDIF} begin {$IFDEF FPC} raise EStringListError.CreateFmt(Msg, [Data]); {$ELSE} raise EStringListError.CreateFmt(Msg, [Data]) at ReturnAddr; {$ENDIF} end; function TdomNameValueList.getLength: integer; begin result:= FNames.Count; end; function TdomNameValueList.getCapacity: integer; begin result:= FNames.Capacity; end; function TdomNameValueList.getDuplicates: TDuplicates; begin result:= FNames.duplicates; end; function TdomNameValueList.getName(index: integer): wideString; begin result:= FNames[index]; end; function TdomNameValueList.getSorted: boolean; begin result:= FNames.sorted; end; function TdomNameValueList.getObject(index: integer): TObject; begin result:= FValues.objects[integer(FNames.objects[index])]; end; function TdomNameValueList.getValue(index: integer): wideString; begin result:= FValues[integer(FNames.objects[index])]; end; procedure TdomNameValueList.putObject(index: integer; aObject: TObject); begin FValues.objects[integer(FNames.objects[index])]:= aObject; end; procedure TdomNameValueList.setCapacity(const value: integer); begin FNames.Capacity:= value; FValues.Capacity:= value; end; procedure TdomNameValueList.setDuplicates(const value: TDuplicates); begin FNames.duplicates:= value; end; procedure TdomNameValueList.setSorted(const Value: boolean); begin FNames.sorted:= value; end; function TdomNameValueList.add(const name, value: wideString): integer; var valueIndex: integer; begin valueIndex:= FValues.Add(value); result:= FNames.addObject(name,Tobject(pointer(valueIndex))); end; procedure TdomNameValueList.addNameValueList(const nvl: TdomNameValueList); var i: integer; begin with nvl do for i:= 0 to pred(length) do self.addObject(names[i],values[i],objects[i]); end; function TdomNameValueList.addObject(const name, value: wideString; AObject: TObject): integer; var valueIndex: integer; begin valueIndex:= FValues.addObject(value,AObject); result:= FNames.addObject(name,Tobject(pointer(valueIndex))); end; procedure TdomNameValueList.assign(source: TPersistent); begin if source is TdomNameValueList then begin if source = self then exit; clear; addNameValueList(TdomNameValueList(source)); exit; end; inherited assign(Source); end; procedure TdomNameValueList.clear; begin FNames.clear; FValues.clear; end; procedure TdomNameValueList.Delete(const index: integer); begin FNames.Delete(index); end; procedure TdomNameValueList.exchange(const index1, index2: integer); begin FNames.exchange(index1,index2); end; function TdomNameValueList.indexOf(const name, value: wideString): integer; var i: integer; begin result:= -1; for i:= 0 to pred(FNames.count) do begin if FNames[i] = name then if FValues[integer(FNames.objects[i])] = value then begin result:= i; exit; end; end; end; function TdomNameValueList.indexOfName(const name: wideString): integer; begin result:= FNames.IndexOf(name); end; procedure TdomNameValueList.insert(const index: integer; const name, value: wideString); var valueIndex: integer; begin valueIndex:= FValues.Add(value); FNames.insertObject(index,name,Tobject(pointer(valueIndex))); end; function TdomNameValueList.find(const name, value: wideString; var index: integer): boolean; begin if FNames.duplicates = dupAccept then begin index:= indexOf(name,value); result:= (index > -1); end else begin result:= FNames.find(name,index); if result then begin if FValues[integer(FNames.objects[index])] <> value then begin index:= -1; result:= false; end; end; end; end; function TdomNameValueList.findOfName(const name: wideString; var index: integer): boolean; begin result:= FNames.find(name,index); end; procedure TdomNameValueList.sort; begin FNames.sort; end; //++++++++++++++++++++++++ TdomNameValueTree +++++++++++++++++++++++++++ destructor TdomNameValueTree.Destroy; var index: integer; begin if assigned(FParentTree) then FParentTree.replaceChild(FParentTree.indexOfChild(self),nil); for index:= 0 to pred(FNames.count) do children[index].free; inherited; end; function TdomNameValueTree.addChild(const name, value: wideString; const child: TdomNameValueTree): integer; begin result:= addChildObject(name,value,child,nil); end; function TdomNameValueTree.addChildObject(const name, value: wideString; const child: TdomNameValueTree; const AObject: TObject): integer; begin if assigned(child) then begin if assigned(child.FParentTree) then error('Child name-value tree is in use elsewhere', 0); if isDescendantOf(child) then error('Circular reference', 0); result:= self.addObject(name,value,AObject); FValues.objects[integer(FNames.objects[result])]:= child; child.FParentTree:= self; end else result:= addObject(name,value,AObject); end; procedure TdomNameValueTree.assign(source: TPersistent); var i: integer; newNameValueTree: TdomNameValueTree; begin if source is TdomNameValueTree then begin if source = self then exit; clear; with TdomNameValueTree(source) do for i:= 0 to pred(length) do begin if hasChild(i) then begin newNameValueTree:= TdomNameValueTree.create; self.addChildObject(names[i],values[i],newNameValueTree,objects[i]); newNameValueTree.assign(children[i]); end else self.addObject(names[i],values[i],objects[i]); end; exit; end; inherited assign(Source); end; procedure TdomNameValueTree.clear; var index: integer; subtree: TdomNameValueTree; begin for index:= 0 to pred(FNames.count) do begin subtree:= children[index]; if assigned(subtree) then with subtree do begin FParentTree:= nil; free; end; end; inherited; end; procedure TdomNameValueTree.Delete(const index: integer); var subtree: TdomNameValueTree; begin subtree:= children[index]; if assigned(subtree) then with subtree do begin FParentTree:= nil; free; end; inherited; end; function TdomNameValueTree.getChild(index: integer): TdomNameValueTree; begin result:= TdomNameValueTree(FValues.objects[integer(FNames.objects[index])]); end; function TdomNameValueTree.hasChild(const index: integer): boolean; begin result:= assigned(FValues.objects[integer(FNames.objects[index])]); end; function TdomNameValueTree.indexOfChild(const child: TdomNameValueTree): integer; var i: integer; begin result:= -1; for i:= 0 to pred(FNames.count) do begin if FValues.objects[integer(FNames.objects[i])] = child then begin result:= i; exit; end; end; end; procedure TdomNameValueTree.insertChild(const index: integer; const name, value: wideString; const child: TdomNameValueTree); begin if assigned(child) then begin if assigned(child.FParentTree) then error('Child name-value tree is in use elsewhere', 0); if isDescendantOf(child) then error('Circular reference', 0); insert(index,name,value); FValues.objects[integer(FNames.objects[index])]:= child; child.FParentTree:= self; end else insert(index,name,value); end; function TdomNameValueTree.isDescendantOf(const nvtree: TdomNameValueTree): boolean; var tree: TdomNameValueTree; begin tree:= self; result:= false; while assigned(tree) do begin tree:= tree.parentTree; if tree = nvtree then begin result:= true; exit; end; end; end; function TdomNameValueTree.replaceChild(const index: integer; const newChild: TdomNameValueTree): TdomNameValueTree; begin if assigned(newChild) then begin if assigned(newChild.FParentTree) then error('Child name-value tree is in use elsewhere', 0); if isDescendantOf(newChild) then error('Circular reference', 0); result:= children[index]; if assigned(result) then result.FParentTree:= nil; FValues.objects[integer(FNames.objects[index])]:= newChild; newChild.FParentTree:= self; end else begin result:= children[index]; if assigned(result) then result.FParentTree:= nil; FValues.objects[integer(FNames.objects[index])]:= nil; end; end; //++++++++++++++++++++++++++ TdomCustomStr +++++++++++++++++++++++++++++ constructor TdomCustomStr.create; begin inherited; reset; end; function TdomCustomStr.getWideChars(indx: integer): wideChar; begin result:= FContent[indx]; end; procedure TdomCustomStr.setWideChars(indx: integer; ch: wideChar); begin FContent[indx]:= ch; end; procedure TdomCustomStr.addWideChar(const Ch: wideChar); begin if FActualLen = FCapacity then begin // Grow FCapacity:= FCapacity + FCapacity div 4; setLength(FContent,FCapacity); end; Inc(FActualLen); FContent[FActualLen]:= Ch; end; procedure TdomCustomStr.addWideString(const s: wideString); var i,l: integer; begin l:= system.length(s); while FActualLen+l > FCapacity do begin // Grow FCapacity:= FCapacity + FCapacity div 4; setLength(Fcontent,FCapacity); end; Inc(FActualLen,l); for i:= 1 to l do FContent[FActualLen-l+i]:= WideChar(s[i]); end; function TdomCustomStr.endsWith(const s: wideString): boolean; var i,offset,sLength: integer; begin sLength:= system.length(s); offset:= FActualLen-sLength; if (offset < 0) or (sLength = 0) then begin result:= false; exit; end; i:= 1; repeat result := FContent[i+offset] = s[i]; Inc(i); until (not result) or (i > sLength); end; function TdomCustomStr.isEqual(const s: wideString): boolean; var i,sLength: integer; begin sLength:= system.length(s); if FActualLen <> sLength then begin result:= false; exit; end; if sLength = 0 then begin result:= true; exit; end; i:= 1; repeat result := FContent[i] = s[i]; Inc(i); until (not result) or (i > sLength); end; procedure TdomCustomStr.reset; begin FCapacity:= 64; setLength(FContent,FCapacity); FActualLen:= 0; end; function TdomCustomStr.startsWith(const s: wideString): boolean; var i,sLength: integer; begin sLength:= system.length(s); if (FActualLen < sLength) or (sLength = 0) then begin result:= false; exit; end; i:= 1; repeat result := FContent[i] = s[i]; Inc(i); until (not result) or (i > sLength); end; function TdomCustomStr.value: wideString; begin Result:= Copy(FContent,1,FActualLen); end; // ++++++++++++++++++++++++ TdomWideStringList ++++++++++++++++++++++++ // The code of this class is based on Delphi's TStringList class destructor TdomWideStringList.destroy; begin FOnChange := nil; FOnChanging := nil; inherited destroy; if FCount <> 0 then Finalize(FList^[0], FCount); FCount := 0; SetCapacity(0); end; function TdomWideStringList.add(s: wideString): integer; begin Result:= AddObject(S, nil); end; function TdomWideStringList.addObject(s: wideString; aObject: TObject): integer; begin if not Sorted then Result:= FCount else if Find(S, Result) then case Duplicates of dupIgnore: Exit; dupError: Error('String list does not allow duplicates', 0); end; InsertItem(Result, S, AObject); end; procedure TdomWideStringList.addWideStrings(strings: TdomWideStringList); var i: integer; begin beginUpdate; try for i:= 0 to pred(strings.count) do addObject(strings[i],strings.objects[i]); finally endUpdate; end; end; procedure TdomWideStringList.append(s: wideString); begin add(S); end; procedure TdomWideStringList.assign(source: TPersistent); begin if source is TdomWideStringList then begin if source = self then exit; beginUpdate; try clear; addWideStrings(TdomWideStringList(source)); finally endUpdate; end; exit; end; inherited assign(Source); end; procedure TdomWideStringList.beginUpdate; begin if FUpdateCount = 0 then setUpdateState(True); inc(FUpdateCount); end; procedure TdomWideStringList.changed; begin if (FUpdateCount = 0) and Assigned(FOnChange) then FOnChange(Self); end; procedure TdomWideStringList.changing; begin if (FUpdateCount = 0) and Assigned(FOnChanging) then FOnChanging(Self); end; procedure TdomWideStringList.clear; begin if FCount <> 0 then begin Changing; Finalize(FList^[0], FCount); FCount := 0; SetCapacity(0); Changed; end; end; procedure TdomWideStringList.Delete(index: integer); begin if (Index < 0) or (Index >= FCount) then Error('List index out of bounds (%d)', Index); Changing; Finalize(FList^[Index]); Dec(FCount); if Index < FCount then System.Move(FList^[Index + 1], FList^[Index], (FCount - Index) * SizeOf(TdomWideStringItem)); Changed; end; procedure TdomWideStringList.endUpdate; begin dec(FUpdateCount); if FUpdateCount = 0 then setUpdateState(False); end; procedure TdomWideStringList.error(const msg: string; data: integer); {$IFNDEF FPC} function ReturnAddr: Pointer; asm MOV EAX,[EBP+4] end; {$ENDIF} begin {$IFDEF FPC} raise EStringListError.CreateFmt(msg, [Data]); {$ELSE} raise EStringListError.CreateFmt(Msg, [Data]) at ReturnAddr; {$ENDIF} end; procedure TdomWideStringList.exchange(index1, index2: integer); begin if (Index1 < 0) or (Index1 >= FCount) then Error('List index out of bounds (%d)', Index1); if (Index2 < 0) or (Index2 >= FCount) then Error('List index out of bounds (%d)', Index2); Changing; ExchangeItems(Index1, Index2); Changed; end; procedure TdomWideStringList.exchangeItems(index1, index2: integer); var Temp: Integer; Item1, Item2: ^TdomWideStringItem; begin Item1 := @FList^[Index1]; Item2 := @FList^[Index2]; Temp := Integer(Item1^.FString); Integer(Item1^.FString) := Integer(Item2^.FString); Integer(Item2^.FString) := Temp; Temp := Integer(Item1^.FObject); Integer(Item1^.FObject) := Integer(Item2^.FObject); Integer(Item2^.FObject) := Temp; end; function TdomWideStringList.find(const s: wideString; var index: Integer): boolean; var L, H, I, C: Integer; begin Result := False; L := 0; H := FCount - 1; while L <= H do begin I := (L + H) shr 1; C := CompareText(FList^[I].FString, S); if C < 0 then L := I + 1 else begin H := I - 1; if C = 0 then begin Result := True; if Duplicates <> dupAccept then L := I; end; end; end; Index := L; end; function TdomWideStringList.get(index: integer): wideString; begin if (Index < 0) or (Index >= FCount) then Error('List index out of bounds (%d)', Index); Result := FList^[Index].FString; end; function TdomWideStringList.getCapacity: Integer; begin Result := FCapacity; end; function TdomWideStringList.getCount: Integer; begin Result := FCount; end; function TdomWideStringList.getObject(index: integer): TObject; begin if (Index < 0) or (Index >= FCount) then Error('List index out of bounds (%d)', Index); Result := FList^[Index].FObject; end; procedure TdomWideStringList.grow; var Delta: Integer; begin if FCapacity > 64 then Delta := FCapacity div 4 else if FCapacity > 8 then Delta := 16 else Delta := 4; SetCapacity(FCapacity + Delta); end; function TdomWideStringList.indexOf(const s: wideString): integer; begin if not Sorted then begin for Result:= 0 to GetCount - 1 do if CompareText(Get(Result), S) = 0 then exit; Result := -1; end else if not Find(S, Result) then result := -1; end; procedure TdomWideStringList.insert(index: integer; const s: wideString); begin InsertObject(Index, S, nil); end; procedure TdomWideStringList.insertObject(index: integer; const s: wideString; AObject: TObject); begin if Sorted then Error('Operation not allowed on sorted string list', 0); if (Index < 0) or (Index > FCount) then Error('List index out of bounds (%d)', Index); InsertItem(Index, S, AObject); end; procedure TdomWideStringList.insertItem(index: integer; const s: wideString; AObject: TObject); begin Changing; if FCount = FCapacity then Grow; if Index < FCount then System.Move(FList^[Index], FList^[Index + 1], (FCount - Index) * SizeOf(TdomWideStringItem)); with FList^[Index] do begin Pointer(FString) := nil; FObject := AObject; FString := S; end; Inc(FCount); Changed; end; procedure TdomWideStringList.put(index: integer; const s: wideString); begin if Sorted then Error('Operation not allowed on sorted string list', 0); if (Index < 0) or (Index >= FCount) then Error('List index out of bounds (%d)', Index); Changing; FList^[Index].FString := S; Changed; end; procedure TdomWideStringList.putObject(index: integer; aObject: TObject); begin if (Index < 0) or (Index >= FCount) then Error('List index out of bounds (%d)', Index); Changing; FList^[Index].FObject := AObject; Changed; end; procedure TdomWideStringList.quickSort(l, r: integer); var I, J: Integer; P: WideString; begin repeat I := L; J := R; P := FList^[(L + R) shr 1].FString; repeat while CompareText(FList^[I].FString, P) < 0 do Inc(I); while CompareText(FList^[J].FString, P) > 0 do Dec(J); if I <= J then begin ExchangeItems(I, J); Inc(I); Dec(J); end; until I > J; if L < J then QuickSort(L, J); L := I; until I >= R; end; procedure TdomWideStringList.setCapacity(newCapacity: integer); begin ReallocMem(FList, NewCapacity * SizeOf(TdomWideStringItem)); FCapacity := NewCapacity; end; procedure TdomWideStringList.setSorted(const value: boolean); begin if FSorted <> Value then begin if Value then Sort; FSorted := Value; end; end; procedure TdomWideStringList.setUpdateState(updating: boolean); begin if Updating then Changing else Changed; end; procedure TdomWideStringList.sort; begin if not sorted and (FCount > 1) then begin changing; quickSort(0, FCount - 1); changed; end; end; // +++++++++++++++++++++++ TdomWideStringStream +++++++++++++++++++++++ // - Provided by Karl Waclawek - // This is a stream interface for widestrings. // Purpose: avoid excessive memory re-allocations that occur with // wideStrings because they are not reference counted. // Note: when the dataString property is accesses, the complete // wideString will be copied out. constructor TdomWideStringStream.CreateFromString(const aString: wideString); begin inherited create; setSize(Length(aString) shl 1); Move(pointer(aString)^, FDataStringP^, FSize); end; destructor TdomWideStringStream.destroy; begin FreeMem(FDataStringP); inherited destroy; end; function TdomWideStringStream.GetDataString: wideString; begin setLength(Result, StringLength); Move(FDataStringP^, pointer(Result)^, FSize); end; function TdomWideStringStream.Read(var Buffer; Count: longint): longint; begin Result := FSize - FPosition; if Result > Count then Result := Count; Move((FDataStringP + FPosition)^, Buffer, Result); Inc(FPosition, Result); end; function TdomWideStringStream.Write(const Buffer; Count: longint): longint; var NewPos: longint; begin Result := Count; NewPos := FPosition + Result; if NewPos > FSize then setSize(((NewPos + 1) shr 1) shl 1); //next larger even value Move(Buffer, (FDataStringP + FPosition)^, Result); FPosition := NewPos; end; function TdomWideStringStream.Seek(Offset: longint; Origin: Word): longint; begin case Origin of soFromBeginning: FPosition := Offset; soFromCurrent: FPosition := FPosition + Offset; soFromEnd: FPosition := FSize - Offset; end; if FPosition > FSize then FPosition := FSize else if FPosition < 0 then FPosition := 0; Result := FPosition; end; function TdomWideStringStream.ReadString(Count: longint): wideString; // Reads Count WideChars from stream and returns them as wideString. var Len: longint; begin if Odd(FPosition) then raise EReadError.create(SCannotReadOddPos); Len := (FSize - FPosition) shr 1; if Len > Count then Len := Count; setLength(Result, Len); Read(pointer(Result)^, Len shl 1); end; procedure TdomWideStringStream.WriteString(const aString: wideString); // Writes aString into stream, starting at StringPosition, overwriting // existing characters and extending the stream if necessary. begin if Odd(FPosition) then raise EWriteError.create(SCannotWriteOddPos); Write(pointer(aString)^, Length(aString) shl 1); end; procedure TdomWideStringStream.SetCapacity(NewCapacity: longint); // sets stream capacity in bytes. begin if NewCapacity < FSize then raise EStreamError.create(SCapacityLessSize); ReallocMem(FDataStringP, NewCapacity); FCapacity := NewCapacity; end; procedure TdomWideStringStream.SetSize(NewSize: longint); // sets stream size in bytes. var Delta: longint; begin if Odd(NewSize) then raise EStreamError.create(SOddSizeInvalid); if NewSize > Capacity then begin Delta := NewSize shr 2; if Delta < 8 then Delta := 8; setCapacity(((NewSize + Delta) shr 2) shl 2); //make it a multiple of 4 end else if NewSize < 0 then raise EStreamError.create(SNegativeSizeInvalid); FSize := NewSize; if FPosition > FSize then FPosition := FSize; end; procedure TdomWideStringStream.SetStringPosition(value: longint); // sets string position in terms of WideChars. begin Position := (value - 1) shl 1; end; function TdomWideStringStream.GetStringPosition: longint; // ets string position in terms of WideChars. begin if Odd(Position) then raise EStreamError.create(SOddPosInvalid); Result := (Position shr 1) + 1; end; procedure TdomWideStringStream.SetStringLength(value: longint); // sets string length in terms of WideChars. begin setSize(value shl 1); end; function TdomWideStringStream.GetStringLength: longint; // gets string length in terms of WideChars. begin Result := FSize shr 1; end; //++++++++++++++++++++++++++++ TIso639Info ++++++++++++++++++++++++++++ constructor TIso639Info.create; begin inherited create; FSupportedLanguages:= [iso639_en]; FNameLanguage:= iso639_en; FAppendSymbolToName:= false; end; procedure TIso639Info.assignTo(dest: TPersistent); var i: integer; begin if dest is TStrings then begin with TStrings(dest) do begin beginUpdate; try clear; try for i:= ord(low(TIso639LanguageCode)) to ord(high(TIso639LanguageCode)) do addObject(UTF16To7BitASCIIStr(codeToName(TIso639LanguageCode(i))),TObject(pointer(i))); except clear; raise; end; finally endUpdate; end; end; end else if dest is TdomWideStringList then begin with TdomWideStringList(dest) do begin beginUpdate; try clear; try for i:= ord(low(TIso639LanguageCode)) to ord(high(TIso639LanguageCode)) do addObject(codeToName(TIso639LanguageCode(i)),tobject(pointer(i))); except clear; raise; end; finally endUpdate; end; end; end else inherited assignTo(dest); end; function TIso639Info.codeToName(const value: TIso639LanguageCode): wideString; begin case nameLanguage of iso639_en: result:= codeToName_en(value); else raise ENot_Supported_Err.create('Not supported error.'); end; end; function TIso639Info.codeToName_en(value: TIso639LanguageCode): wideString; begin if value = iso639_aa then result:= 'Afar' else if value = iso639_ab then result:= 'Abkhazian' else if value = iso639_af then result:= 'Afrikaans' else if value = iso639_am then result:= 'Amharic' else if value = iso639_ar then result:= 'Arabic' else if value = iso639_as then result:= 'Assamese' else if value = iso639_ay then result:= 'Aymara' else if value = iso639_az then result:= 'Azerbaijani' else if value = iso639_ba then result:= 'Bashkir' else if value = iso639_be then result:= 'Byelorussian' else if value = iso639_bg then result:= 'Bulgarian' else if value = iso639_bh then result:= 'Bihari' else if value = iso639_bi then result:= 'Bislama' else if value = iso639_bn then result:= 'Bengali; Bangla' else if value = iso639_bo then result:= 'Tibetan' else if value = iso639_br then result:= 'Breton' else if value = iso639_ca then result:= 'Catalan' else if value = iso639_co then result:= 'Corsican' else if value = iso639_cs then result:= 'Czech' else if value = iso639_cy then result:= 'Welsh' else if value = iso639_da then result:= 'Danish' else if value = iso639_de then result:= 'German' else if value = iso639_dz then result:= 'Bhutani' else if value = iso639_el then result:= 'Greek' else if value = iso639_en then result:= 'English' else if value = iso639_eo then result:= 'Esperanto' else if value = iso639_es then result:= 'Spanish' else if value = iso639_et then result:= 'Estonian' else if value = iso639_eu then result:= 'Basque' else if value = iso639_fa then result:= 'Persian' else if value = iso639_fi then result:= 'Finnish' else if value = iso639_fj then result:= 'Fiji' else if value = iso639_fo then result:= 'Faeroese' else if value = iso639_fr then result:= 'French' else if value = iso639_fy then result:= 'Frisian' else if value = iso639_ga then result:= 'Irish' else if value = iso639_gd then result:= 'Scots Gaelic' else if value = iso639_gl then result:= 'Galician' else if value = iso639_gn then result:= 'Guarani' else if value = iso639_gu then result:= 'Gujarati' else if value = iso639_ha then result:= 'Hausa' else if value = iso639_hi then result:= 'Hindi' else if value = iso639_hr then result:= 'Croatian' else if value = iso639_hu then result:= 'Hungarian' else if value = iso639_hy then result:= 'Armenian' else if value = iso639_ia then result:= 'Interlingua' else if value = iso639_ie then result:= 'Interlingue' else if value = iso639_ik then result:= 'Inupiak' else if value = iso639_in then result:= 'Indonesian' else if value = iso639_is then result:= 'Icelandic' else if value = iso639_it then result:= 'Italian' else if value = iso639_iw then result:= 'Hebrew' else if value = iso639_ja then result:= 'Japanese' else if value = iso639_ji then result:= 'Yiddish' else if value = iso639_jw then result:= 'Javanese' else if value = iso639_ka then result:= 'Georgian' else if value = iso639_kk then result:= 'Kazakh' else if value = iso639_kl then result:= 'Greenlandic' else if value = iso639_km then result:= 'Cambodian' else if value = iso639_kn then result:= 'Kannada' else if value = iso639_ko then result:= 'Korean' else if value = iso639_ks then result:= 'Kashmiri' else if value = iso639_ku then result:= 'Kurdish' else if value = iso639_ky then result:= 'Kirghiz' else if value = iso639_la then result:= 'Latin' else if value = iso639_ln then result:= 'Lingala' else if value = iso639_lo then result:= 'Laothian' else if value = iso639_lt then result:= 'Lithuanian' else if value = iso639_lv then result:= 'Latvian; Lettish' else if value = iso639_mg then result:= 'Malagasy' else if value = iso639_mi then result:= 'Maori' else if value = iso639_mk then result:= 'Macedonian' else if value = iso639_ml then result:= 'Malayalam' else if value = iso639_mn then result:= 'Mongolian' else if value = iso639_mo then result:= 'Moldavian' else if value = iso639_mr then result:= 'Marathi' else if value = iso639_ms then result:= 'Malay' else if value = iso639_mt then result:= 'Maltese' else if value = iso639_my then result:= 'Burmese' else if value = iso639_na then result:= 'Nauru' else if value = iso639_ne then result:= 'Nepali' else if value = iso639_nl then result:= 'Dutch' else if value = iso639_no then result:= 'Norwegian' else if value = iso639_oc then result:= 'Occitan' else if value = iso639_om then result:= 'Afan; Oromo' else if value = iso639_or then result:= 'Oriya' else if value = iso639_pa then result:= 'Punjabi' else if value = iso639_pl then result:= 'Polish' else if value = iso639_ps then result:= 'Pashto; Pushto' else if value = iso639_pt then result:= 'Portuguese' else if value = iso639_qu then result:= 'Quechua' else if value = iso639_rm then result:= 'Rhaeto-Romance' else if value = iso639_rn then result:= 'Kirundi' else if value = iso639_ro then result:= 'Romanian' else if value = iso639_ru then result:= 'Russian' else if value = iso639_rw then result:= 'Kinyarwanda' else if value = iso639_sa then result:= 'Sanskrit' else if value = iso639_sd then result:= 'Sindhi' else if value = iso639_sg then result:= 'Sangro' else if value = iso639_sh then result:= 'Serbo-Croatian' else if value = iso639_si then result:= 'Singhalese' else if value = iso639_sk then result:= 'Slovak' else if value = iso639_sl then result:= 'Slovenian' else if value = iso639_sm then result:= 'Samoan' else if value = iso639_sn then result:= 'Shona' else if value = iso639_so then result:= 'Somali' else if value = iso639_sq then result:= 'Albanian' else if value = iso639_sr then result:= 'Serbian' else if value = iso639_ss then result:= 'Siswati' else if value = iso639_st then result:= 'Sesotho' else if value = iso639_su then result:= 'Sundanese' else if value = iso639_sv then result:= 'Swedish' else if value = iso639_sw then result:= 'Swahili' else if value = iso639_ta then result:= 'Tamil' else if value = iso639_te then result:= 'Tegulu' else if value = iso639_tg then result:= 'Tajik' else if value = iso639_th then result:= 'Thai' else if value = iso639_ti then result:= 'Tigrinya' else if value = iso639_tk then result:= 'Turkmen' else if value = iso639_tl then result:= 'Tagalog' else if value = iso639_tn then result:= 'Setswana' else if value = iso639_to then result:= 'Tonga' else if value = iso639_tr then result:= 'Turkish' else if value = iso639_ts then result:= 'Tsonga' else if value = iso639_tt then result:= 'Tatar' else if value = iso639_tw then result:= 'Twi' else if value = iso639_uk then result:= 'Ukrainian' else if value = iso639_ur then result:= 'Urdu' else if value = iso639_uz then result:= 'Uzbek' else if value = iso639_vi then result:= 'Vietnamese' else if value = iso639_vo then result:= 'Volapuk' else if value = iso639_wo then result:= 'Wolof' else if value = iso639_xh then result:= 'Xhosa' else if value = iso639_yo then result:= 'Yoruba' else if value = iso639_zh then result:= 'Chinese' else if value = iso639_zu then result:= 'Zulu' ; if FAppendSymbolToName then result:= concat(result,' [',codeToSymbol(value),']'); end; function TIso639Info.codeToSymbol(const value: TIso639LanguageCode): wideString; begin if value = iso639_aa then result:= 'aa' // Afar else if value = iso639_ab then result:= 'ab' // Abkhazian else if value = iso639_af then result:= 'af' // Afrikaans else if value = iso639_am then result:= 'am' // Amharic else if value = iso639_ar then result:= 'ar' // Arabic else if value = iso639_as then result:= 'as' // Assamese else if value = iso639_ay then result:= 'ay' // Aymara else if value = iso639_az then result:= 'az' // Azerbaijani else if value = iso639_ba then result:= 'ba' // Bashkir else if value = iso639_be then result:= 'be' // Byelorussian else if value = iso639_bg then result:= 'bg' // Bulgarian else if value = iso639_bh then result:= 'bh' // Bihari else if value = iso639_bi then result:= 'bi' // Bislama else if value = iso639_bn then result:= 'bn' // Bengali; Bangla else if value = iso639_bo then result:= 'bo' // Tibetan else if value = iso639_br then result:= 'br' // Breton else if value = iso639_ca then result:= 'ca' // Catalan else if value = iso639_co then result:= 'co' // Corsican else if value = iso639_cs then result:= 'cs' // Czech else if value = iso639_cy then result:= 'cy' // Welsh else if value = iso639_da then result:= 'da' // Danish else if value = iso639_de then result:= 'de' // German else if value = iso639_dz then result:= 'dz' // Bhutani else if value = iso639_el then result:= 'el' // Greek else if value = iso639_en then result:= 'en' // English else if value = iso639_eo then result:= 'eo' // Esperanto else if value = iso639_es then result:= 'es' // Spanish else if value = iso639_et then result:= 'et' // Estonian else if value = iso639_eu then result:= 'eu' // Basque else if value = iso639_fa then result:= 'fa' // Persian else if value = iso639_fi then result:= 'fi' // Finnish else if value = iso639_fj then result:= 'fj' // Fiji else if value = iso639_fo then result:= 'fo' // Faeroese else if value = iso639_fr then result:= 'fr' // French else if value = iso639_fy then result:= 'fy' // Frisian else if value = iso639_ga then result:= 'ga' // Irish else if value = iso639_gd then result:= 'gd' // Scots Gaelic else if value = iso639_gl then result:= 'gl' // Galician else if value = iso639_gn then result:= 'gn' // Guarani else if value = iso639_gu then result:= 'gu' // Gujarati else if value = iso639_ha then result:= 'ha' // Hausa else if value = iso639_hi then result:= 'hi' // Hindi else if value = iso639_hr then result:= 'hr' // Croatian else if value = iso639_hu then result:= 'hu' // Hungarian else if value = iso639_hy then result:= 'hy' // Armenian else if value = iso639_ia then result:= 'ia' // Interlingua else if value = iso639_ie then result:= 'ie' // Interlingue else if value = iso639_ik then result:= 'ik' // Inupiak else if value = iso639_in then result:= 'in' // Indonesian else if value = iso639_is then result:= 'is' // Icelandic else if value = iso639_it then result:= 'it' // Italian else if value = iso639_iw then result:= 'iw' // Hebrew else if value = iso639_ja then result:= 'ja' // Japanese else if value = iso639_ji then result:= 'ji' // Yiddish else if value = iso639_jw then result:= 'jw' // Javanese else if value = iso639_ka then result:= 'ka' // Georgian else if value = iso639_kk then result:= 'kk' // Kazakh else if value = iso639_kl then result:= 'kl' // Greenlandic else if value = iso639_km then result:= 'km' // Cambodian else if value = iso639_kn then result:= 'kn' // Kannada else if value = iso639_ko then result:= 'ko' // Korean else if value = iso639_ks then result:= 'ks' // Kashmiri else if value = iso639_ku then result:= 'ku' // Kurdish else if value = iso639_ky then result:= 'ky' // Kirghiz else if value = iso639_la then result:= 'la' // Latin else if value = iso639_ln then result:= 'ln' // Lingala else if value = iso639_lo then result:= 'lo' // Laothian else if value = iso639_lt then result:= 'lt' // Lithuanian else if value = iso639_lv then result:= 'lv' // Latvian; Lettish else if value = iso639_mg then result:= 'mg' // Malagasy else if value = iso639_mi then result:= 'mi' // Maori else if value = iso639_mk then result:= 'mk' // Macedonian else if value = iso639_ml then result:= 'ml' // Malayalam else if value = iso639_mn then result:= 'mn' // Mongolian else if value = iso639_mo then result:= 'mo' // Moldavian else if value = iso639_mr then result:= 'mr' // Marathi else if value = iso639_ms then result:= 'ms' // Malay else if value = iso639_mt then result:= 'mt' // Maltese else if value = iso639_my then result:= 'my' // Burmese else if value = iso639_na then result:= 'na' // Nauru else if value = iso639_ne then result:= 'ne' // Nepali else if value = iso639_nl then result:= 'nl' // Dutch else if value = iso639_no then result:= 'no' // Norwegian else if value = iso639_oc then result:= 'oc' // Occitan else if value = iso639_om then result:= 'om' // Afan; Oromo else if value = iso639_or then result:= 'or' // Oriya else if value = iso639_pa then result:= 'pa' // Punjabi else if value = iso639_pl then result:= 'pl' // Polish else if value = iso639_ps then result:= 'ps' // Pashto; Pushto else if value = iso639_pt then result:= 'pt' // Portuguese else if value = iso639_qu then result:= 'qu' // Quechua else if value = iso639_rm then result:= 'rm' // Rhaeto-Romance else if value = iso639_rn then result:= 'rn' // Kirundi else if value = iso639_ro then result:= 'ro' // Romanian else if value = iso639_ru then result:= 'ru' // Russian else if value = iso639_rw then result:= 'rw' // Kinyarwanda else if value = iso639_sa then result:= 'sa' // Sanskrit else if value = iso639_sd then result:= 'sd' // Sindhi else if value = iso639_sg then result:= 'sg' // Sangro else if value = iso639_sh then result:= 'sh' // Serbo-Croatian else if value = iso639_si then result:= 'si' // Singhalese else if value = iso639_sk then result:= 'sk' // Slovak else if value = iso639_sl then result:= 'sl' // Slovenian else if value = iso639_sm then result:= 'sm' // Samoan else if value = iso639_sn then result:= 'sn' // Shona else if value = iso639_so then result:= 'so' // Somali else if value = iso639_sq then result:= 'sq' // Albanian else if value = iso639_sr then result:= 'sr' // Serbian else if value = iso639_ss then result:= 'ss' // Siswati else if value = iso639_st then result:= 'st' // Sesotho else if value = iso639_su then result:= 'su' // Sundanese else if value = iso639_sv then result:= 'sv' // Swedish else if value = iso639_sw then result:= 'sw' // Swahili else if value = iso639_ta then result:= 'ta' // Tamil else if value = iso639_te then result:= 'te' // Tegulu else if value = iso639_tg then result:= 'tg' // Tajik else if value = iso639_th then result:= 'th' // Thai else if value = iso639_ti then result:= 'ti' // Tigrinya else if value = iso639_tk then result:= 'tk' // Turkmen else if value = iso639_tl then result:= 'tl' // Tagalog else if value = iso639_tn then result:= 'tn' // Setswana else if value = iso639_to then result:= 'to' // Tonga else if value = iso639_tr then result:= 'tr' // Turkish else if value = iso639_ts then result:= 'ts' // Tsonga else if value = iso639_tt then result:= 'tt' // Tatar else if value = iso639_tw then result:= 'tw' // Twi else if value = iso639_uk then result:= 'uk' // Ukrainian else if value = iso639_ur then result:= 'ur' // Urdu else if value = iso639_uz then result:= 'uz' // Uzbek else if value = iso639_vi then result:= 'vi' // Vietnamese else if value = iso639_vo then result:= 'vo' // Volapuk else if value = iso639_wo then result:= 'wo' // Wolof else if value = iso639_xh then result:= 'xh' // Xhosa else if value = iso639_yo then result:= 'yo' // Yoruba else if value = iso639_zh then result:= 'zh' // Chinese else if value = iso639_zu then result:= 'zu' // Zulu ; end; function TIso639Info.nameToCode(const value: wideString): TIso639LanguageCode; begin case nameLanguage of iso639_en: result:= nameToCode_en(value); else raise ENot_Supported_Err.create('Not supported error.'); end; end; function TIso639Info.nameToCode_en(value: wideString): TIso639LanguageCode; var i,j: integer; dummy: wideString; begin i:= pos(';',value); if i > 0 then begin dummy:= copy(value,1,i-1); value:= dummy; end else begin j:= pos('[',value); if j > 1 then begin if value[j] = ' ' then begin dummy:= copy(value,1,j-2); value:= dummy; end; end; end; if value = 'Afar' then result:= iso639_aa else if value = 'Abkhazian' then result:= iso639_ab else if value = 'Afrikaans' then result:= iso639_af else if value = 'Amharic' then result:= iso639_am else if value = 'Arabic' then result:= iso639_ar else if value = 'Assamese' then result:= iso639_as else if value = 'Aymara' then result:= iso639_ay else if value = 'Azerbaijani' then result:= iso639_az else if value = 'Bashkir' then result:= iso639_ba else if value = 'Byelorussian' then result:= iso639_be else if value = 'Bulgarian' then result:= iso639_bg else if value = 'Bihari' then result:= iso639_bh else if value = 'Bislama' then result:= iso639_bi else if value = 'Bengali' then result:= iso639_bn else if value = 'Bangla' then result:= iso639_bn else if value = 'Tibetan' then result:= iso639_bo else if value = 'Breton' then result:= iso639_br else if value = 'Catalan' then result:= iso639_ca else if value = 'Corsican' then result:= iso639_co else if value = 'Czech' then result:= iso639_cs else if value = 'Welsh' then result:= iso639_cy else if value = 'Danish' then result:= iso639_da else if value = 'German' then result:= iso639_de else if value = 'Bhutani' then result:= iso639_dz else if value = 'Greek' then result:= iso639_el else if value = 'English' then result:= iso639_en else if value = 'Esperanto' then result:= iso639_eo else if value = 'Spanish' then result:= iso639_es else if value = 'Estonian' then result:= iso639_et else if value = 'Basque' then result:= iso639_eu else if value = 'Persian' then result:= iso639_fa else if value = 'Finnish' then result:= iso639_fi else if value = 'Fiji' then result:= iso639_fj else if value = 'Faeroese' then result:= iso639_fo else if value = 'French' then result:= iso639_fr else if value = 'Frisian' then result:= iso639_fy else if value = 'Irish' then result:= iso639_ga else if value = 'Scots Gaelic' then result:= iso639_gd else if value = 'Galician' then result:= iso639_gl else if value = 'Guarani' then result:= iso639_gn else if value = 'Gujarati' then result:= iso639_gu else if value = 'Hausa' then result:= iso639_ha else if value = 'Hindi' then result:= iso639_hi else if value = 'Croatian' then result:= iso639_hr else if value = 'Hungarian' then result:= iso639_hu else if value = 'Armenian' then result:= iso639_hy else if value = 'Interlingua' then result:= iso639_ia else if value = 'Interlingue' then result:= iso639_ie else if value = 'Inupiak' then result:= iso639_ik else if value = 'Indonesian' then result:= iso639_in else if value = 'Icelandic' then result:= iso639_is else if value = 'Italian' then result:= iso639_it else if value = 'Hebrew' then result:= iso639_iw else if value = 'Japanese' then result:= iso639_ja else if value = 'Yiddish' then result:= iso639_ji else if value = 'Javanese' then result:= iso639_jw else if value = 'Georgian' then result:= iso639_ka else if value = 'Kazakh' then result:= iso639_kk else if value = 'Greenlandic' then result:= iso639_kl else if value = 'Cambodian' then result:= iso639_km else if value = 'Kannada' then result:= iso639_kn else if value = 'Korean' then result:= iso639_ko else if value = 'Kashmiri' then result:= iso639_ks else if value = 'Kurdish' then result:= iso639_ku else if value = 'Kirghiz' then result:= iso639_ky else if value = 'Latin' then result:= iso639_la else if value = 'Lingala' then result:= iso639_ln else if value = 'Laothian' then result:= iso639_lo else if value = 'Lithuanian' then result:= iso639_lt else if value = 'Latvian' then result:= iso639_lv else if value = 'Lettish' then result:= iso639_lv else if value = 'Malagasy' then result:= iso639_mg else if value = 'Maori' then result:= iso639_mi else if value = 'Macedonian' then result:= iso639_mk else if value = 'Malayalam' then result:= iso639_ml else if value = 'Mongolian' then result:= iso639_mn else if value = 'Moldavian' then result:= iso639_mo else if value = 'Marathi' then result:= iso639_mr else if value = 'Malay' then result:= iso639_ms else if value = 'Maltese' then result:= iso639_mt else if value = 'Burmese' then result:= iso639_my else if value = 'Nauru' then result:= iso639_na else if value = 'Nepali' then result:= iso639_ne else if value = 'Dutch' then result:= iso639_nl else if value = 'Norwegian' then result:= iso639_no else if value = 'Occitan' then result:= iso639_oc else if value = 'Afan' then result:= iso639_om else if value = 'Oromo' then result:= iso639_om else if value = 'Oriya' then result:= iso639_or else if value = 'Punjabi' then result:= iso639_pa else if value = 'Polish' then result:= iso639_pl else if value = 'Pashto' then result:= iso639_ps else if value = 'Pushto' then result:= iso639_ps else if value = 'Portuguese' then result:= iso639_pt else if value = 'Quechua' then result:= iso639_qu else if value = 'Rhaeto-Romance' then result:= iso639_rm else if value = 'Kirundi' then result:= iso639_rn else if value = 'Romanian' then result:= iso639_ro else if value = 'Russian' then result:= iso639_ru else if value = 'Kinyarwanda' then result:= iso639_rw else if value = 'Sanskrit' then result:= iso639_sa else if value = 'Sindhi' then result:= iso639_sd else if value = 'Sangro' then result:= iso639_sg else if value = 'Serbo-Croatian' then result:= iso639_sh else if value = 'Singhalese' then result:= iso639_si else if value = 'Slovak' then result:= iso639_sk else if value = 'Slovenian' then result:= iso639_sl else if value = 'Samoan' then result:= iso639_sm else if value = 'Shona' then result:= iso639_sn else if value = 'Somali' then result:= iso639_so else if value = 'Albanian' then result:= iso639_sq else if value = 'Serbian' then result:= iso639_sr else if value = 'Siswati' then result:= iso639_ss else if value = 'Sesotho' then result:= iso639_st else if value = 'Sundanese' then result:= iso639_su else if value = 'Swedish' then result:= iso639_sv else if value = 'Swahili' then result:= iso639_sw else if value = 'Tamil' then result:= iso639_ta else if value = 'Tegulu' then result:= iso639_te else if value = 'Tajik' then result:= iso639_tg else if value = 'Thai' then result:= iso639_th else if value = 'Tigrinya' then result:= iso639_ti else if value = 'Turkmen' then result:= iso639_tk else if value = 'Tagalog' then result:= iso639_tl else if value = 'Setswana' then result:= iso639_tn else if value = 'Tonga' then result:= iso639_to else if value = 'Turkish' then result:= iso639_tr else if value = 'Tsonga' then result:= iso639_ts else if value = 'Tatar' then result:= iso639_tt else if value = 'Twi' then result:= iso639_tw else if value = 'Ukrainian' then result:= iso639_uk else if value = 'Urdu' then result:= iso639_ur else if value = 'Uzbek' then result:= iso639_uz else if value = 'Vietnamese' then result:= iso639_vi else if value = 'Volapuk' then result:= iso639_vo else if value = 'Wolof' then result:= iso639_wo else if value = 'Xhosa' then result:= iso639_xh else if value = 'Yoruba' then result:= iso639_yo else if value = 'Chinese' then result:= iso639_zh else if value = 'Zulu' then result:= iso639_zu else raise EConvertError.Create('Invalid ISO 639 language name'); end; procedure TIso639Info.setNameLanguage(const value: TIso639LanguageCode); begin if not (value in FSupportedLanguages) then raise ENot_Supported_Err.create('Not supported error.'); end; function TIso639Info.symbolToCode(const value: wideString): TIso639LanguageCode; begin if value = 'aa' then result:= iso639_aa // Afar else if value = 'ab' then result:= iso639_ab // Abkhazian else if value = 'af' then result:= iso639_af // Afrikaans else if value = 'am' then result:= iso639_am // Amharic else if value = 'ar' then result:= iso639_ar // Arabic else if value = 'as' then result:= iso639_as // Assamese else if value = 'ay' then result:= iso639_ay // Aymara else if value = 'az' then result:= iso639_az // Azerbaijani else if value = 'ba' then result:= iso639_ba // Bashkir else if value = 'be' then result:= iso639_be // Byelorussian else if value = 'bg' then result:= iso639_bg // Bulgarian else if value = 'bh' then result:= iso639_bh // Bihari else if value = 'bi' then result:= iso639_bi // Bislama else if value = 'bn' then result:= iso639_bn // Bengali; Bangla else if value = 'bo' then result:= iso639_bo // Tibetan else if value = 'br' then result:= iso639_br // Breton else if value = 'ca' then result:= iso639_ca // Catalan else if value = 'co' then result:= iso639_co // Corsican else if value = 'cs' then result:= iso639_cs // Czech else if value = 'cy' then result:= iso639_cy // Welsh else if value = 'da' then result:= iso639_da // Danish else if value = 'de' then result:= iso639_de // German else if value = 'dz' then result:= iso639_dz // Bhutani else if value = 'el' then result:= iso639_el // Greek else if value = 'en' then result:= iso639_en // English else if value = 'eo' then result:= iso639_eo // Esperanto else if value = 'es' then result:= iso639_es // Spanish else if value = 'et' then result:= iso639_et // Estonian else if value = 'eu' then result:= iso639_eu // Basque else if value = 'fa' then result:= iso639_fa // Persian else if value = 'fi' then result:= iso639_fi // Finnish else if value = 'fj' then result:= iso639_fj // Fiji else if value = 'fo' then result:= iso639_fo // Faeroese else if value = 'fr' then result:= iso639_fr // French else if value = 'fy' then result:= iso639_fy // Frisian else if value = 'ga' then result:= iso639_ga // Irish else if value = 'gd' then result:= iso639_gd // Scots Gaelic else if value = 'gl' then result:= iso639_gl // Galician else if value = 'gn' then result:= iso639_gn // Guarani else if value = 'gu' then result:= iso639_gu // Gujarati else if value = 'ha' then result:= iso639_ha // Hausa else if value = 'hi' then result:= iso639_hi // Hindi else if value = 'hr' then result:= iso639_hr // Croatian else if value = 'hu' then result:= iso639_hu // Hungarian else if value = 'hy' then result:= iso639_hy // Armenian else if value = 'ia' then result:= iso639_ia // Interlingua else if value = 'ie' then result:= iso639_ie // Interlingue else if value = 'ik' then result:= iso639_ik // Inupiak else if value = 'in' then result:= iso639_in // Indonesian else if value = 'is' then result:= iso639_is // Icelandic else if value = 'it' then result:= iso639_it // Italian else if value = 'iw' then result:= iso639_iw // Hebrew else if value = 'ja' then result:= iso639_ja // Japanese else if value = 'ji' then result:= iso639_ji // Yiddish else if value = 'jw' then result:= iso639_jw // Javanese else if value = 'ka' then result:= iso639_ka // Georgian else if value = 'kk' then result:= iso639_kk // Kazakh else if value = 'kl' then result:= iso639_kl // Greenlandic else if value = 'km' then result:= iso639_km // Cambodian else if value = 'kn' then result:= iso639_kn // Kannada else if value = 'ko' then result:= iso639_ko // Korean else if value = 'ks' then result:= iso639_ks // Kashmiri else if value = 'ku' then result:= iso639_ku // Kurdish else if value = 'ky' then result:= iso639_ky // Kirghiz else if value = 'la' then result:= iso639_la // Latin else if value = 'ln' then result:= iso639_ln // Lingala else if value = 'lo' then result:= iso639_lo // Laothian else if value = 'lt' then result:= iso639_lt // Lithuanian else if value = 'lv' then result:= iso639_lv // Latvian; Lettish else if value = 'mg' then result:= iso639_mg // Malagasy else if value = 'mi' then result:= iso639_mi // Maori else if value = 'mk' then result:= iso639_mk // Macedonian else if value = 'ml' then result:= iso639_ml // Malayalam else if value = 'mn' then result:= iso639_mn // Mongolian else if value = 'mo' then result:= iso639_mo // Moldavian else if value = 'mr' then result:= iso639_mr // Marathi else if value = 'ms' then result:= iso639_ms // Malay else if value = 'mt' then result:= iso639_mt // Maltese else if value = 'my' then result:= iso639_my // Burmese else if value = 'na' then result:= iso639_na // Nauru else if value = 'ne' then result:= iso639_ne // Nepali else if value = 'nl' then result:= iso639_nl // Dutch else if value = 'no' then result:= iso639_no // Norwegian else if value = 'oc' then result:= iso639_oc // Occitan else if value = 'om' then result:= iso639_om // Afan; Oromo else if value = 'or' then result:= iso639_or // Oriya else if value = 'pa' then result:= iso639_pa // Punjabi else if value = 'pl' then result:= iso639_pl // Polish else if value = 'ps' then result:= iso639_ps // Pashto; Pushto else if value = 'pt' then result:= iso639_pt // Portuguese else if value = 'qu' then result:= iso639_qu // Quechua else if value = 'rm' then result:= iso639_rm // Rhaeto-Romance else if value = 'rn' then result:= iso639_rn // Kirundi else if value = 'ro' then result:= iso639_ro // Romanian else if value = 'ru' then result:= iso639_ru // Russian else if value = 'rw' then result:= iso639_rw // Kinyarwanda else if value = 'sa' then result:= iso639_sa // Sanskrit else if value = 'sd' then result:= iso639_sd // Sindhi else if value = 'sg' then result:= iso639_sg // Sangro else if value = 'sh' then result:= iso639_sh // Serbo-Croatian else if value = 'si' then result:= iso639_si // Singhalese else if value = 'sk' then result:= iso639_sk // Slovak else if value = 'sl' then result:= iso639_sl // Slovenian else if value = 'sm' then result:= iso639_sm // Samoan else if value = 'sn' then result:= iso639_sn // Shona else if value = 'so' then result:= iso639_so // Somali else if value = 'sq' then result:= iso639_sq // Albanian else if value = 'sr' then result:= iso639_sr // Serbian else if value = 'ss' then result:= iso639_ss // Siswati else if value = 'st' then result:= iso639_st // Sesotho else if value = 'su' then result:= iso639_su // Sundanese else if value = 'sv' then result:= iso639_sv // Swedish else if value = 'sw' then result:= iso639_sw // Swahili else if value = 'ta' then result:= iso639_ta // Tamil else if value = 'te' then result:= iso639_te // Tegulu else if value = 'tg' then result:= iso639_tg // Tajik else if value = 'th' then result:= iso639_th // Thai else if value = 'ti' then result:= iso639_ti // Tigrinya else if value = 'tk' then result:= iso639_tk // Turkmen else if value = 'tl' then result:= iso639_tl // Tagalog else if value = 'tn' then result:= iso639_tn // Setswana else if value = 'to' then result:= iso639_to // Tonga else if value = 'tr' then result:= iso639_tr // Turkish else if value = 'ts' then result:= iso639_ts // Tsonga else if value = 'tt' then result:= iso639_tt // Tatar else if value = 'tw' then result:= iso639_tw // Twi else if value = 'uk' then result:= iso639_uk // Ukrainian else if value = 'ur' then result:= iso639_ur // Urdu else if value = 'uz' then result:= iso639_uz // Uzbek else if value = 'vi' then result:= iso639_vi // Vietnamese else if value = 'vo' then result:= iso639_vo // Volapuk else if value = 'wo' then result:= iso639_wo // Wolof else if value = 'xh' then result:= iso639_xh // Xhosa else if value = 'yo' then result:= iso639_yo // Yoruba else if value = 'zh' then result:= iso639_zh // Chinese else if value = 'zu' then result:= iso639_zu // Zulu else raise EConvertError.Create('Invalid ISO 639 language symbol'); end; //+++++++++++++++++++++++ TdomImplementation ++++++++++++++++++++++++++ constructor TdomImplementation.create(aOwner: TComponent); begin inherited create(aOwner); FCreatedCMObjectsListing:= TList.create; FCreatedCMObjects:= TdomCMNodeList.create(FCreatedCMObjectsListing); FCreatedDocumentsListing:= TList.create; FCreatedDocuments:= TdomNodeList.create(FCreatedDocumentsListing); FCreatedDocumentTypesListing:= TList.create; FCreatedDocumentTypes:= TdomNodeList.create(FCreatedDocumentTypesListing); FCreatedCMExternalObjectsListing:= TList.create; FCreatedCMExternalObjects:= TdomCMNodeList.create(FCreatedCMExternalObjectsListing); FCreatedCMInternalObjectsListing:= TList.create; FCreatedCMInternalObjects:= TdomCMNodeList.create(FCreatedCMInternalObjectsListing); end; destructor TdomImplementation.destroy; begin clear; FCreatedCMObjectsListing.free; FCreatedCMObjects.free; FCreatedDocumentsListing.free; FCreatedDocuments.free; FCreatedDocumentTypesListing.free; FCreatedDocumentTypes.free; FCreatedCMExternalObjectsListing.free; FCreatedCMExternalObjects.free; FCreatedCMInternalObjectsListing.free; FCreatedCMInternalObjects.free; inherited destroy; end; procedure TdomImplementation.clear; var i: integer; begin for i:= 0 to FCreatedDocumentsListing.count-1 do begin TdomDocument(FCreatedDocumentsListing[i]).clear; // destroys all child nodes, nodeIterators and treeWalkers TdomDocument(FCreatedDocumentsListing[i]).free; FCreatedDocumentsListing[i]:= nil; end; FCreatedDocumentsListing.pack; FCreatedDocumentsListing.Capacity:= FCreatedDocumentsListing.Count; for i:= 0 to FCreatedDocumentTypesListing.count-1 do begin TdomDocumentType(FCreatedDocumentTypesListing[i]).free; FCreatedDocumentTypesListing[i]:= nil; end; FCreatedDocumentTypesListing.pack; FCreatedDocumentTypesListing.Capacity:= FCreatedDocumentTypesListing.Count; for i:= 0 to FCreatedCMExternalObjectsListing.count-1 do begin TdomCMExternalObject(FCreatedCMExternalObjectsListing[i]).free; FCreatedCMExternalObjectsListing[i]:= nil; end; FCreatedCMExternalObjectsListing.pack; FCreatedCMExternalObjectsListing.Capacity:= FCreatedCMExternalObjectsListing.Count; for i:= 0 to FCreatedCMInternalObjectsListing.count-1 do begin TdomCMInternalObject(FCreatedCMInternalObjectsListing[i]).free; FCreatedCMInternalObjectsListing[i]:= nil; end; FCreatedCMInternalObjectsListing.pack; FCreatedCMInternalObjectsListing.Capacity:= FCreatedCMInternalObjectsListing.Count; for i:= 0 to FCreatedCMObjectsListing.count-1 do begin TdomCMObject(FCreatedCMObjectsListing[i]).free; FCreatedCMObjectsListing[i]:= nil; end; FCreatedCMObjectsListing.pack; FCreatedCMObjectsListing.Capacity:= FCreatedCMObjectsListing.Count; end; function TdomImplementation.createCMExternalObject(const pubId, sysId: wideString): TdomCMExternalObject; begin Result:= TdomCMExternalObject.create(self,pubId,sysId); FCreatedCMExternalObjectsListing.add(Result); end; function TdomImplementation.createCMInternalObject(const pubId, sysId: wideString): TdomCMInternalObject; begin Result:= TdomCMInternalObject.create(self,pubId,sysId); FCreatedCMInternalObjectsListing.add(Result); end; function TdomImplementation.createCMObject(const sysId: wideString): TdomCMObject; begin Result:= TdomCMObject.create(self,sysId); FCreatedCMObjectsListing.add(Result); end; function TdomImplementation.createDocument(const aname: wideString; doctype: TdomDocumentType): TdomDocument; begin if assigned(doctype) then if documentTypes.IndexOf(doctype) = -1 then raise EWrong_Document_Err.create('Wrong document error.'); if not IsXmlName(aname) then raise EInvalid_Character_Err.create('Invalid character error.'); if SupportsDocumentFormat('',aname) then Result:= getDocumentClass('',aname).create(self) else Result:= TdomDocument.create(self); FCreatedDocumentsListing.add(Result); if assigned(doctype) then begin FCreatedDocumentTypes.FNodeList.Remove(doctype); doctype.FDocument:= Result; Result.appendChild(doctype); end; Result.InitDoc(aname); end; function TdomImplementation.createDocumentNS(const namespaceURI, qualifiedName: wideString; doctype: TdomDocumentType): TdomDocument; var prfx, localName: wideString; begin if assigned(doctype) then if documentTypes.IndexOf(doctype) = -1 then raise EWrong_Document_Err.create('Wrong document error.'); if not xmlExtractPrefixAndLocalName(qualifiedName,prfx,localName) then begin if not IsXmlName(qualifiedName) then raise EInvalid_Character_Err.create('Invalid character error.') else raise ENamespace_Err.create('Namespace error.'); end; if ( ((prfx = 'xmlns') or (qualifiedName = 'xmlns')) and not (namespaceURI = 'http://www.w3.org/2000/xmlns/') ) then raise ENamespace_Err.create('Namespace error.'); if (namespaceURI = '') and (prfx <> '') then raise ENamespace_Err.create('Namespace error.'); if (prfx = 'xml') and (namespaceURI <> 'http://www.w3.org/XML/1998/namespace') then raise ENamespace_Err.create('Namespace error.'); if SupportsDocumentFormat(namespaceURI,qualifiedName) then Result:= getDocumentClass(namespaceURI,qualifiedName).create(self) else Result:= TdomDocument.create(self); FCreatedDocuments.FNodeList.add(Result); if assigned(doctype) then begin FCreatedDocumentTypes.FNodeList.Remove(doctype); doctype.FDocument:= Result; Result.appendChild(doctype); end; Result.InitDocNS(namespaceURI,qualifiedName); end; { The following two methods have been removed from this version of the XDOM, but will be reintroduced in a further release. function TdomImplementation.createDocumentType(const name, publicId, systemId, intSubset: wideString): TdomDocumentType; begin if not IsXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); Result:= TdomDocumentType.create(nil,name,publicId,systemId,intSubset); FCreatedDocumentTypes.FNodeList.add(Result); end; function TdomImplementation.createDocumentTypeNS(const qualifiedName, publicId, systemId, intSubset: wideString): TdomDocumentType; begin if not IsXmlName(qualifiedName) then raise EInvalid_Character_Err.create('Invalid character error.'); if not IsXmlQName(qualifiedName) then raise ENamespace_Err.create('Namespace error.'); Result:= TdomDocumentType.create(nil,qualifiedName,publicId,systemId,intSubset); FCreatedDocumentTypes.FNodeList.add(Result); end; } procedure TdomImplementation.freeCMExternalObject(var arg: TdomCMExternalObject); var index: integer; dummyArg: TdomCMExternalObject; begin if not assigned(arg) then exit; dummyArg:= arg; index:= FCreatedCMExternalObjectsListing.IndexOf(arg); if index = -1 then raise ENot_Found_Err.create('External content model not found error.'); // remove the content model from its associated content models: if assigned(arg.associatedContentModel) then arg.associatedContentModel.removeExternalCM; // free the external content model itself: FCreatedCMExternalObjectsListing.Delete(index); dummyArg.free; // Use dummyArg here, because the call to removeExternalCM // can set the FCMInternal field of the document being // processed in TdomImplementation.FreeDocument to nil. // Since arg is a var parameter, it will be set to nil, and // will not be freed at the end of the procedure. arg:= nil; end; procedure TdomImplementation.freeCMInternalObject(var arg: TdomCMInternalObject); var index: integer; dummyArg: TdomCMInternalObject; begin if not assigned(arg) then exit; dummyArg:= arg; index:= FCreatedCMInternalObjectsListing.indexOf(arg); if index = -1 then raise ENot_Found_Err.create('Internal content model not found error.'); // remove the content model from its associated content model: if assigned(arg.associatedContentModel) then arg.associatedContentModel.removeInternalCM; // free the Internal content model itself: FCreatedCMInternalObjectsListing.Delete(index); dummyArg.free; // Use dummyArg here, because the call to removeInternalCM // can set the FCMInternal field of the document being // processed in TdomImplementation.FreeDocument to nil. // Since arg is a var parameter, it will be set to nil, and // will not be freed at the end of the procedure. arg:= nil; end; procedure TdomImplementation.freeCMObject(var arg: TdomCMObject); var index: integer; dummyArg: TdomCMObject; begin if not assigned(arg) then exit; dummyArg:= arg; index:= FCreatedCMObjectsListing.IndexOf(arg); if index = -1 then raise ENot_Found_Err.create('Content model not found error.'); // remove associated content models arg.removeExternalCM; arg.removeInternalCM; // remove the content model from its associated document: if assigned(arg.associatedDocument) then arg.associatedDocument.removeContentModel; // free the content model itself: FCreatedCMObjectsListing.Delete(index); dummyArg.free; // Use dummyArg here, because the call to removeContentModel // can set the FCMInternal field of the document being // processed in TdomImplementation.FreeDocument to nil. // Since arg is a var parameter, it will be set to nil, and // will not be freed at the end of the procedure. arg:= nil; end; procedure TdomImplementation.freeDocument(var doc: TdomDocument); var index: integer; begin if not assigned(doc) then exit; index:= FCreatedDocumentsListing.IndexOf(doc); if index = -1 then raise ENot_Found_Err.create('Document not found error.'); // free the content model associated with the document: if assigned(doc.FCMInternal) then FreeCMObject(doc.FCMInternal); // free all child nodes, nodeIterators and treeWalkers: doc.clear; // free the document itself: FCreatedDocumentsListing.Delete(index); doc.free; doc:= nil; end; procedure TdomImplementation.freeDocumentType(var docType: TdomDocumentType); var index: integer; begin if not assigned(docType) then exit; index:= FCreatedDocumentTypesListing.IndexOf(docType); if index = -1 then raise ENot_Found_Err.create('DocumentType not found error.'); FCreatedDocumentTypesListing.Delete(index); docType.free; docType:= nil; end; function TdomImplementation.getCMObjects: TdomCMNodeList; begin result:= FCreatedCMObjects; end; function TdomImplementation.getDocuments: TdomNodeList; begin Result:= FCreatedDocuments; end; function TdomImplementation.getDocumentTypes: TdomNodeList; begin Result:= FCreatedDocumentTypes; end; procedure TDomImplementation.doAttrModified(modifiedDoc: TdomDocument; modifiedNode: TdomNode; attrChange: TdomAttrChange; prevValue, newValue: wideString; relatedAttr: TdomAttr); begin if assigned(FOnAttrModified) then FOnAttrModified(self,modifiedDoc,modifiedNode,attrChange,prevValue,newValue,relatedAttr); end; procedure TDomImplementation.doCharacterDataModified(modifiedDoc: TdomDocument; modifiedNode: TdomNode; prevValue, newValue: wideString); begin if assigned(FOnCharacterDataModified) then FOnCharacterDataModified(self,modifiedDoc,modifiedNode,prevValue,newValue); end; procedure TdomImplementation.doError( sender: TObject; error: TdomError; var go: boolean); begin case error.severity of DOM_SEVERITY_WARNING, DOM_SEVERITY_ERROR: go:= true; DOM_SEVERITY_FATAL_ERROR: go:= false; end; if assigned(FOnError) then FOnError(sender,error,go); end; procedure TDomImplementation.doExternalParsedEntity(parentSystemId: wideString; var publicId, systemId: wideString; var stream: TStream; var action: TXmlParserAction); begin if assigned(FOnExternalParsedEntity) then repeat FOnExternalParsedEntity(self,parentSystemId,publicId,systemId,stream,action); until action <> paRetry; end; procedure TDomImplementation.doNodeInserted(modifiedDoc: TdomDocument; modifiedNode: TdomNode); begin if assigned(FOnNodeInserted) then FOnNodeInserted(self,modifiedDoc,modifiedNode); end; procedure TDomImplementation.doNodeRemoved(modifiedDoc: TdomDocument; modifiedNode: TdomNode); begin if assigned(FOnNodeRemoved) then FOnNodeRemoved(self,modifiedDoc,modifiedNode); end; function TdomImplementation.getCMExternalObjects: TdomCMNodeList; begin result:= FCreatedCMExternalObjects; end; function TdomImplementation.getCMInternalObjects: TdomCMNodeList; begin result:= FCreatedCMInternalObjects; end; function TDomImplementation.getXdomVersion: wideString; begin result:= '2.3.27'; end; function TdomImplementation.hasFeature(const feature, version: wideString): boolean; var VersionStr: string; begin Result:= false; VersionStr:= WideCharToString(PWideChar(feature)); if (WideCharToString(PWideChar(version))='1.0') or (WideCharToString(PWideChar(version))='') then begin if (CompareText(VersionStr,'XML')=0) then Result:= true; end else begin if (WideCharToString(PWideChar(version))='2.0') then begin if (CompareText(VersionStr,'XML')=0) then Result:= true; if (CompareText(VersionStr,'VIEWS')=0) then Result:= true; if (CompareText(VersionStr,'TRAVERSAL')=0) then Result:= true; end else begin if version = '' then begin if (CompareText(VersionStr,'XML')=0) then Result:= true; if (CompareText(VersionStr,'VIEWS')=0) then Result:= true; if (CompareText(VersionStr,'TRAVERSAL')=0) then Result:= true; end; {if ... } end; {if ... else ...} end; {if ... else ...} end; function TdomImplementation.GetDocumentClass(const aNamespaceUri, aQualifiedName: wideString): TdomDocumentClass; var aDocFormat: PdomDocumentFormat; begin aDocFormat := domDocumentFormatList; while aDocFormat <> nil do with aDocFormat^ do begin if (aNamespaceUri = aNamespaceUri) and (aQualifiedName = qualifiedName) then begin Result:= DocumentClass; exit; end else aDocFormat := next; end; raise EUnknown_Document_Format_Err.create('Unknown document format yet'); end; function TDomImplementation.handleError(const sender: TObject; const error: TdomError): boolean; begin if not assigned(error) then raise ENot_Supported_Err.create('Not supported error.'); doError(sender,error,result); end; class procedure TdomImplementation.RegisterDocumentFormat(const aNamespaceUri, aQualifiedName: wideString; aDocumentClass: TdomDocumentClass); var newRec: PdomDocumentFormat; begin if aQualifiedName = 'default' then raise EInvalid_Access_Err.create('Illegal Parameter Error: Attempt to set the reserved Document Format "default".'); new(newRec); with newRec^ do begin documentClass:= aDocumentClass; NamespaceUri:= aNamespaceUri; qualifiedName:= aQualifiedName; next:= domDocumentFormatList; end; domDocumentFormatList:= newRec; end; function TdomImplementation.SupportsDocumentFormat(const aNamespaceUri, aQualifiedName: wideString): boolean; var aDocFormat: PdomDocumentFormat; begin Result:= false; aDocFormat:= domDocumentFormatList; while aDocFormat <> nil do with aDocFormat^ do begin if (aNamespaceUri = NamespaceUri) and (aQualifiedName = qualifiedName) then begin Result:= true; exit; end else aDocFormat := next; end; end; class procedure TdomImplementation.UnregisterDocumentClass(const aDocumentClass: TdomDocumentClass); var aDocFormat,oldRec,previous: PdomDocumentFormat; begin previous:= nil; aDocFormat := domDocumentFormatList; while aDocFormat <> nil do with aDocFormat^ do begin if aDocumentClass = DocumentClass then begin oldRec:= aDocFormat; if assigned(previous) then previous^.next:= next else domDocumentFormatList := next; previous:= aDocFormat; aDocFormat := next; Dispose(oldRec); end else begin previous:= aDocFormat; aDocFormat := next; end; end; {with ...} end; //++++++++++++++++++++++++++++ TdomTreeWalker +++++++++++++++++++++++++++++++ constructor TdomTreeWalker.create(const Root: TdomNode; const WhatToShow: TdomWhatToShow; const NodeFilter: TdomNodeFilter; const EntityReferenceExpansion: boolean); begin if not assigned(Root) then raise ENot_Supported_Err.create('Not supported error.'); inherited create; FWhatToShow:= WhatToShow; FFilter:= NodeFilter; FExpandEntityReferences:= EntityReferenceExpansion; FRoot:= Root; FCurrentNode:= Root; end; procedure TdomTreeWalker.SetCurrentNode(const node: TdomNode); begin if not assigned(node) then raise ENot_Supported_Err.create('Not supported error.'); FCurrentNode:= node; end; procedure TdomTreeWalker.setExpandEntityReferences(const value: boolean); begin FExpandEntityReferences:= value; end; procedure TdomTreeWalker.setFilter(const value: TdomNodeFilter); begin FFilter:= value; end; procedure TdomTreeWalker.setRoot(const node: TdomNode); begin if not assigned(node) then raise ENot_Supported_Err.create('Not supported error.'); FRoot:= node; end; procedure TdomTreeWalker.setWhatToShow(const value: TdomWhatToShow); begin FWhatToShow:= value; end; function TdomTreeWalker.FindNextSibling(const oldNode: TdomNode): TdomNode; var accept: TdomFilterResult; newNode: TdomNode; begin Result:= nil; if oldNode = root then exit; newNode:= oldNode.NextSibling; if assigned(newNode) then begin if newNode.NodeType in FWhatToShow then begin if assigned(FFilter) then accept:= FFilter.acceptNode(newNode) else accept:= filter_accept; end else accept:= filter_skip; case accept of filter_reject: Result:= FindNextSibling(newNode); filter_skip: begin Result:= FindFirstChild(newNode); if not assigned(result) then Result:= FindNextSibling(newNode); end; filter_accept: Result:= newNode; end; {case ...} end else begin if not assigned(oldNode.parentNode) then begin result:= nil; exit; end; // TreeWalker.root not found! if oldNode.parentNode.NodeType in FWhatToShow then begin if assigned(FFilter) then accept:= FFilter.acceptNode(oldNode.parentNode) else accept:= filter_accept; end else accept:= filter_skip; case accept of filter_reject, filter_skip: Result:= FindNextSibling(oldNode.parentNode); filter_accept: Result:= nil; end; {case ...} end; end; function TdomTreeWalker.FindPreviousSibling(const OldNode: TdomNode): TdomNode; var accept: TdomFilterResult; newNode: TdomNode; begin Result:= nil; if OldNode = root then exit; newNode:= oldNode.PreviousSibling; if assigned(newNode) then begin if newNode.NodeType in FWhatToShow then begin if assigned(FFilter) then accept:= FFilter.acceptNode(newNode) else accept:= filter_accept; end else accept:= filter_skip; case accept of filter_reject: Result:= FindPreviousSibling(newNode); filter_skip: begin Result:= FindLastChild(newNode); if not assigned(result) then Result:= FindPreviousSibling(newNode); end; filter_accept: Result:= newNode; end; {case ...} end else begin if not assigned(oldNode.parentNode) then begin result:= nil; exit; end; // TreeWalker.root not found! if oldNode.parentNode.NodeType in FWhatToShow then begin if assigned(FFilter) then accept:= FFilter.acceptNode(oldNode.parentNode) else accept:= filter_accept; end else accept:= filter_skip; case accept of filter_reject, filter_skip: Result:= FindPreviousSibling(oldNode.parentNode); filter_accept: Result:= nil; end; {case ...} end; end; function TdomTreeWalker.FindParentNode(const OldNode: TdomNode): TdomNode; var accept: TdomFilterResult; begin Result:= nil; if OldNode = root then exit; Result:= OldNode.ParentNode; if not assigned(Result) then begin result:= nil; exit; end; // TreeWalker.root not found! if Result.NodeType in FWhatToShow then begin if assigned(FFilter) then accept:= FFilter.acceptNode(Result) else accept:= filter_accept; end else accept:= filter_skip; case accept of filter_reject, filter_skip: Result:= FindParentNode(Result); end; end; function TdomTreeWalker.FindFirstChild(const oldNode: TdomNode): TdomNode; var i: integer; newNode: TdomNode; accept: TdomFilterResult; begin Result:= nil; if (oldNode.nodeType = ntEntity_Reference_Node) and not FExpandEntityReferences then exit; for i:= 0 to pred(oldnode.childNodes.length) do begin newNode:= oldnode.childNodes.item(i); if newNode.NodeType in FWhatToShow then begin if assigned(FFilter) then accept:= FFilter.acceptNode(newNode) else accept:= filter_accept; end else accept:= filter_skip; case accept of filter_skip: Result:= FindFirstChild(newNode); filter_accept: Result:= newNode; end; {case ...} if assigned(result) then break; end; {for ...} end; function TdomTreeWalker.FindLastChild(const OldNode: TdomNode): TdomNode; var i: integer; newNode: TdomNode; accept: TdomFilterResult; begin Result:= nil; if (oldNode.nodeType = ntEntity_Reference_Node) and not FExpandEntityReferences then exit; for i:= pred(oldnode.childNodes.length) downto 0 do begin newNode:= oldnode.childNodes.item(i); if newNode.NodeType in FWhatToShow then begin if assigned(FFilter) then accept:= FFilter.acceptNode(newNode) else accept:= filter_accept; end else accept:= filter_skip; case accept of filter_skip: Result:= FindLastChild(newNode); filter_accept: Result:= newNode; end; {case ...} if assigned(result) then break; end; {for ...} end; function TdomTreeWalker.FindNextNode(OldNode: TdomNode): TdomNode; var newNode: TdomNode; begin Result:= FindFirstChild(oldNode); if OldNode = root then exit; if not assigned(Result) then Result:= FindNextSibling(oldNode); while not assigned(Result) do begin newNode:= FindParentNode(oldNode); if not assigned(newNode) then exit; // No next node. Result:= FindNextSibling(newNode); oldNode:= newNode; end; end; function TdomTreeWalker.FindPreviousNode(const OldNode: TdomNode): TdomNode; var newNode: TdomNode; begin Result:= nil; if OldNode = root then exit; Result:= FindPreviousSibling(oldNode); if assigned(Result) then begin newNode:= FindLastChild(Result); if assigned(newNode) then result:= newNode; end else result:= FindParentNode(oldNode); end; function TdomTreeWalker.parentNode: TdomNode; begin Result:= FindParentNode(FCurrentNode); if assigned(Result) then FCurrentNode:= Result; end; function TdomTreeWalker.firstChild: TdomNode; begin Result:= FindFirstChild(FCurrentNode); if assigned(Result) then FCurrentNode:= Result; end; function TdomTreeWalker.lastChild: TdomNode; begin Result:= FindLastChild(FCurrentNode); if assigned(Result) then FCurrentNode:= Result; end; function TdomTreeWalker.previousSibling: TdomNode; begin Result:= FindPreviousSibling(FCurrentNode); if assigned(Result) then FCurrentNode:= Result; end; function TdomTreeWalker.nextSibling: TdomNode; begin Result:= FindNextSibling(FCurrentNode); if assigned(Result) then FCurrentNode:= Result; end; function TdomTreeWalker.previousNode: TdomNode; begin Result:= FindPreviousNode(FCurrentNode); if assigned(Result) then FCurrentNode:= Result; end; function TdomTreeWalker.nextNode: TdomNode; begin Result:= FindNextNode(FCurrentNode); if assigned(Result) then FCurrentNode:= Result; end; //++++++++++++++++++++++++++++ TdomNodeIterator +++++++++++++++++++++++++++++++ constructor TdomNodeIterator.create(const Root: TdomNode; const WhatToShow: TdomWhatToShow; const nodeFilter: TdomNodeFilter; const EntityReferenceExpansion: boolean); begin if not assigned(Root) then raise ENot_Supported_Err.create('Not supported error.'); inherited create; FRoot:= root; FWhatToShow:= WhatToShow; FFilter:= NodeFilter; FExpandEntityReferences:= EntityReferenceExpansion; FReferenceNode:= Root; FInvalid:= false; FPosition:= posBefore; end; procedure TdomNodeIterator.FindNewReferenceNode(const nodeToRemove: TdomNode); var newRefNode: TdomNode; newPosition: TdomPosition; begin newRefNode:= nil; newPosition:= FPosition; case FPosition of posBefore: begin newRefNode:= nodeToRemove.NextSibling; if not assigned(newRefNode) then begin newRefNode:= FindPreviousNode(nodeToRemove); newPosition:= posAfter; end; end; posAfter: begin newRefNode:= nodeToRemove.NextSibling; if not assigned(newRefNode) then begin newRefNode:= FindPreviousNode(nodeToRemove); newPosition:= posBefore; end; end; end; {case ...} if assigned(newRefNode) then begin FReferenceNode:= newRefNode; FPosition:= newPosition; end; end; procedure TdomNodeIterator.detach; begin FReferenceNode:= nil; FInvalid:= true; end; function TdomNodeIterator.FindNextNode(OldNode: TdomNode): TdomNode; var newNode: TdomNode; begin with OldNode do if HasChildNodes and ( FExpandEntityReferences or (nodeType <> ntEntity_Reference_Node) ) then result:= FirstChild else result:= NextSibling; while not assigned(Result) do begin newNode:= oldNode.ParentNode; if not assigned(newNode) then exit; // No next node. Result:= newNode.NextSibling; oldNode:= newNode; end; end; function TdomNodeIterator.FindPreviousNode(const OldNode: TdomNode): TdomNode; var newNode: TdomNode; begin with OldNode do begin result:= PreviousSibling; if assigned(result) then begin newNode:= result; while assigned(newNode) do begin result:= newNode; newNode:= newNode.LastChild; end; end else result:= ParentNode; end; end; function TdomNodeIterator.NextNode: TdomNode; var accept: TdomFilterResult; newNode: TdomNode; begin newNode:= nil; if FInvalid then raise EInvalid_State_Err.create('Invalid state error.'); case FPosition of posBefore: begin FPosition:= posAfter; newNode:= FReferenceNode; end; posAfter: begin newNode:= FindNextNode(FReferenceNode); end; end; repeat accept:= filter_accept; if assigned(newNode) then begin if newNode.NodeType in FWhatToShow then begin if assigned(FFilter) then accept:= FFilter.acceptNode(newNode); end else accept:= filter_skip; if not (accept = filter_accept) then newNode:= FindNextNode(newNode); end; until accept = filter_accept; if assigned(newNode) then if not (newNode.IsAncestor(root) or (newNode = root)) then if (FReferenceNode.IsAncestor(root) or (FReferenceNode = root)) then newNode:= nil; if assigned(newNode) then FReferenceNode:= newNode; Result:= newNode; end; function TdomNodeIterator.PreviousNode: TdomNode; var accept: TdomFilterResult; newNode: TdomNode; begin newNode:= nil; if FInvalid then raise EInvalid_State_Err.create('Invalid state error.'); case FPosition of posBefore: begin newNode:= FindPreviousNode(FReferenceNode); end; posAfter: begin FPosition:= posBefore; newNode:= FReferenceNode; end; end; repeat accept:= filter_accept; if assigned(newNode) then begin if newNode.NodeType in FWhatToShow then begin if assigned(FFilter) then accept:= FFilter.acceptNode(newNode); end else accept:= filter_skip; if not (accept = filter_accept) then newNode:= FindPreviousNode(newNode); end; until accept = filter_accept; if assigned(newNode) then if not (newNode.IsAncestor(root) or (newNode = root)) then if (FReferenceNode.IsAncestor(root) or (FReferenceNode = root)) then newNode:= nil; if assigned(newNode) then FReferenceNode:= newNode; Result:= newNode; end; //++++++++++++++++++++++++++++ TdomNodeList +++++++++++++++++++++++++++++++ constructor TdomNodeList.create(const nodeList: TList); begin inherited create; FNodeList:= nodeList; end; function TdomNodeList.getLength: integer; begin Result:= FNodeList.count; end; function TdomNodeList.indexOf(const node: TdomNode): integer; begin Result:= FNodeList.IndexOf(node); end; function TdomNodeList.item(const index: integer): TdomNode; begin if (index < 0) or (index >= FNodeList.Count) then result:= nil else result:= TdomNode(FNodeList.List^[Index]); end; //++++++++++++++++++++++++ TdomElementsNodeList ++++++++++++++++++++++++++ constructor TdomElementsNodeList.create(const QueryName: wideString; const StartElement: TdomNode); begin inherited create(nil); FQueryName:= QueryName; FStartElement:= StartElement; end; function TdomElementsNodeList.GetLength: integer; var AktNode,NewNode: TdomNode; Level: integer; begin Result:= 0; if not assigned(FStartElement) then exit; Level:= 0; AktNode:= FStartElement; if AktNode.NodeType = ntElement_Node then if (AktNode.NodeName = FQueryName) or (FQueryName = '*') then inc(Result); repeat if AktNode.HasChildNodes then begin NewNode:= AktNode.FirstChild; inc(Level); end else NewNode:= AktNode.NextSibling; while not assigned(NewNode) do begin dec(Level); if Level < 1 then break; AktNode:= AktNode.ParentNode; NewNode:= AktNode.NextSibling; end; if Level < 1 then break; AktNode:= NewNode; if AktNode.NodeType = ntElement_Node then if (AktNode.NodeName = FQueryName) or (FQueryName = '*') then inc(Result); until Level < 1; end; function TdomElementsNodeList.IndexOf(const node: TdomNode): integer; var AktNode,NewNode: TdomNode; Level,i: integer; begin Result:= -1; if not assigned(FStartElement) then exit; if not (node is TdomNode) then exit; if node.NodeType <> ntElement_Node then exit; i:= -1; Level:= 0; AktNode:= FStartElement; repeat if AktNode.HasChildNodes then begin NewNode:= AktNode.FirstChild; inc(Level); end else NewNode:= AktNode.NextSibling; while not assigned(NewNode) do begin dec(Level); if Level < 1 then break; AktNode:= AktNode.ParentNode; NewNode:= AktNode.NextSibling; end; if Level < 1 then break; AktNode:= NewNode; if AktNode.NodeType = ntElement_Node then if (AktNode.NodeName = FQueryName) or (FQueryName = '*') then begin inc(i); if AktNode = node then begin Result:= i; break; end; end; until Level < 1; end; function TdomElementsNodeList.Item(const index: integer): TdomNode; var AktNode,NewNode: TdomNode; Level,i: integer; begin Result:= nil; if not assigned(FStartElement) then exit; if (index < 0) then exit; i:= -1; Level:= 0; AktNode:= FStartElement; repeat if AktNode.HasChildNodes then begin NewNode:= AktNode.FirstChild; inc(Level); end else NewNode:= AktNode.NextSibling; while not assigned(NewNode) do begin dec(Level); if Level < 1 then break; AktNode:= AktNode.ParentNode; NewNode:= AktNode.NextSibling; end; if Level < 1 then break; AktNode:= NewNode; if AktNode.NodeType = ntElement_Node then if (AktNode.NodeName = FQueryName) or (FQueryName = '*') then begin inc(i); if i = index then begin Result:= AktNode; break; end; end; until Level < 1; end; //+++++++++++++++++++++TdomElementsNodeListNS ++++++++++++++++++++++++++ constructor TdomElementsNodeListNS.create(const QueryNamespaceURI, QueryLocalName: wideString; const StartElement: TdomNode); begin inherited create(nil); FQueryNamespaceURI:= QueryNamespaceURI; FQueryLocalName:= QueryLocalName; FStartElement:= StartElement; end; function TdomElementsNodeListNS.GetLength: integer; var AktNode,NewNode: TdomNode; Level: integer; begin Result:= 0; if not assigned(FStartElement) then exit; Level:= 0; AktNode:= FStartElement; repeat if AktNode.HasChildNodes then begin NewNode:= AktNode.FirstChild; inc(Level); end else NewNode:= AktNode.NextSibling; while not assigned(NewNode) do begin dec(Level); if Level < 1 then break; AktNode:= AktNode.ParentNode; NewNode:= AktNode.NextSibling; end; if Level < 1 then break; AktNode:= NewNode; if AktNode.NodeType = ntElement_Node then if ((AktNode.namespaceURI = FQueryNamespaceURI) or (FQueryNamespaceURI = '*')) and ((AktNode.localName = FQueryLocalName) or (FQueryLocalName = '*')) then inc(Result); until Level < 1; end; function TdomElementsNodeListNS.IndexOf(const node: TdomNode): integer; var AktNode,NewNode: TdomNode; Level,i: integer; begin Result:= -1; if not assigned(FStartElement) then exit; if not (node is TdomNode) then exit; if node.NodeType <> ntElement_Node then exit; i:= -1; Level:= 0; AktNode:= FStartElement; repeat if AktNode.HasChildNodes then begin NewNode:= AktNode.FirstChild; inc(Level); end else NewNode:= AktNode.NextSibling; while not assigned(NewNode) do begin dec(Level); if Level < 1 then break; AktNode:= AktNode.ParentNode; NewNode:= AktNode.NextSibling; end; if Level < 1 then break; AktNode:= NewNode; if AktNode.NodeType = ntElement_Node then if ((AktNode.namespaceURI = FQueryNamespaceURI) or (FQueryNamespaceURI = '*')) and ((AktNode.localName = FQueryLocalName) or (FQueryLocalName = '*')) then begin inc(i); if AktNode = node then begin Result:= i; break; end; end; until Level < 1; end; function TdomElementsNodeListNS.Item(const index: integer): TdomNode; var AktNode,NewNode: TdomNode; Level,i: integer; begin Result:= nil; if not assigned(FStartElement) then exit; if (index < 0) then exit; i:= -1; Level:= 0; AktNode:= FStartElement; repeat if AktNode.HasChildNodes then begin NewNode:= AktNode.FirstChild; inc(Level); end else NewNode:= AktNode.NextSibling; while not assigned(NewNode) do begin dec(Level); if Level < 1 then break; AktNode:= AktNode.ParentNode; NewNode:= AktNode.NextSibling; end; if Level < 1 then break; AktNode:= NewNode; if AktNode.NodeType = ntElement_Node then if ((AktNode.namespaceURI = FQueryNamespaceURI) or (FQueryNamespaceURI = '*')) and ((AktNode.localName = FQueryLocalName) or (FQueryLocalName = '*')) then begin inc(i); if i = index then begin Result:= AktNode; break; end; end; until Level < 1; end; //++++++++++++++++++++++++ TdomSpecialNodeList ++++++++++++++++++++++++++ constructor TdomSpecialNodeList.create(const nodeList: TList; const allowedNTs: TDomNodeTypeSet); begin inherited create(nodeList); FAllowedNodeTypes:= allowedNTs; end; function TdomSpecialNodeList.GetLength: integer; var i: integer; begin Result:= 0; for i:= 0 to FNodeList.count-1 do if TdomNode(FNodeList[i]).NodeType in FAllowedNodeTypes then inc(Result); end; function TdomSpecialNodeList.IndexOf(const node: TdomNode): integer; var i: integer; begin Result:= -1; if not (node.NodeType in FAllowedNodeTypes) then exit; for i:= 0 to FNodeList.count-1 do begin if TdomNode(FNodeList[i]).NodeType in FAllowedNodeTypes then inc(Result); if TdomNode(FNodeList[i]) = node then begin Result:= i; break; end; end; end; function TdomSpecialNodeList.Item(const index: integer): TdomNode; var i,j: integer; begin Result:= nil; j:= -1; if (index < 0) or (index > FNodeList.count-1) then exit; for i:= 0 to FNodeList.count-1 do begin if TdomNode(FNodeList[i]).NodeType in FAllowedNodeTypes then inc(j); if j = index then begin Result:= TdomNode(FNodeList[i]); break; end; end; end; function TdomSpecialNodeList.GetNamedIndex(const name: wideString): integer; var i,j: integer; begin result:= -1; j:= -1; for i:= 0 to FNodeList.count-1 do if TdomNode(FNodeList[i]).NodeType in FAllowedNodeTypes then begin inc(j); if (TdomNode(FNodeList[i]).NodeName = name) then begin Result:= j; break; end; end; end; function TdomSpecialNodeList.GetNamedItem(const name: wideString): TdomNode; var i: integer; begin result:= nil; for i:= 0 to FNodeList.count-1 do if (TdomNode(FNodeList[i]).NodeName = name) and (TdomNode(FNodeList[i]).NodeType in FAllowedNodeTypes) then begin Result:= TdomNode(FNodeList[i]); break; end; end; //+++++++++++++++++++++++++ TdomNamedNodeMap +++++++++++++++++++++++++++++ constructor TdomNamedNodeMap.create(const aOwner, aOwnerNode: TdomNode; const nodeList: TList; const allowedNTs: TDomNodeTypeSet); begin inherited create(nodeList); FOwner:= aOwner; FOwnerNode:= aOwnerNode; FAllowedNodeTypes:= allowedNTs; FNamespaceAware:= false; FIsReadonly:= false; end; function TdomNamedNodeMap.getOwnerNode: TdomNode; begin Result:= FOwnerNode; end; function TdomNamedNodeMap.getNamespaceAware: boolean; begin Result:= FNamespaceAware; end; procedure TdomNamedNodeMap.setNamespaceAware(const value: boolean); begin if FNodeList.count > 0 then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); FNamespaceAware:= value; end; function TdomNamedNodeMap.RemoveItem(const arg: TdomNode): TdomNode; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if FNodeList.IndexOf(arg) = -1 then raise ENot_Found_Err.create('Node not found error.'); Result:= arg; FNodeList.Remove(arg); Result.FParentNode:= nil; end; procedure TdomNamedNodeMap.setIsReadonly(const value: boolean); begin FIsReadonly:= value; end; function TdomNamedNodeMap.GetNamedIndex(const name: wideString): integer; var i: integer; begin if FNamespaceAware then raise ENamespace_Err.create('Namespace error.'); result:= -1; for i:= 0 to FNodeList.count-1 do if (TdomNode(FNodeList[i]).NodeName = name) and (TdomNode(FNodeList[i]).NodeType in FAllowedNodeTypes) then begin Result:= i; break; end; end; function TdomNamedNodeMap.GetNamedItem(const name: wideString): TdomNode; var i: integer; begin if FNamespaceAware then raise ENamespace_Err.create('Namespace error.'); result:= nil; for i:= 0 to FNodeList.count-1 do if (TdomNode(FNodeList[i]).NodeName = name) and (TdomNode(FNodeList[i]).NodeType in FAllowedNodeTypes) then begin Result:= TdomNode(FNodeList[i]); break; end; end; function TdomNamedNodeMap.SetNamedItem(const arg: TdomNode): TdomNode; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if FNamespaceAware then raise ENamespace_Err.create('Namespace error.'); if FOwner.OwnerDocument <> arg.OwnerDocument then raise EWrong_Document_Err.create('Wrong document error.'); if not (arg.NodeType in FAllowedNodeTypes) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); if assigned(arg.parentNode) then raise EInuse_Node_Err.create('Inuse node error.'); if arg.NodeType = ntAttribute_Node then if assigned((arg as TdomAttr).OwnerElement) then if (arg as TdomAttr).OwnerElement <> FOwnerNode then raise EInuse_Attribute_Err.create('Inuse attribute error.'); if assigned(GetNamedItem(arg.NodeName)) then Result:= RemoveNamedItem(arg.NodeName) else Result:= nil; FNodeList.Add(arg); arg.FParentNode:= nil; if (arg.NodeType = ntAttribute_Node) and (FOwnerNode.NodeType = ntElement_Node) then (arg as TdomAttr).FownerElement:= TdomElement(FOwnerNode); end; function TdomNamedNodeMap.RemoveNamedItem(const name: wideString): TdomNode; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if FNamespaceAware then raise ENamespace_Err.create('Namespace error.'); Result:= getNamedItem(name); if not assigned(Result) then raise ENot_Found_Err.create('Node not found error.'); FNodeList.Remove(Result); if Result.NodeType = ntAttribute_Node then (Result as TdomAttr).FownerElement:= nil; end; function TdomNamedNodeMap.GetNamedItemNS(const namespaceURI, localName: wideString): TdomNode; var i: integer; begin if not FNamespaceAware then raise ENamespace_Err.create('Namespace error.'); result:= nil; for i:= 0 to FNodeList.count-1 do if (TdomNode(FNodeList[i]).namespaceURI = namespaceURI) and (TdomNode(FNodeList[i]).localName = localName) and (TdomNode(FNodeList[i]).NodeType in FAllowedNodeTypes) then begin Result:= TdomNode(FNodeList[i]); break; end; end; function TdomNamedNodeMap.SetNamedItemNS(const arg: TdomNode): TdomNode; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if not FNamespaceAware then raise ENamespace_Err.create('Namespace error.'); if FOwner.OwnerDocument <> arg.OwnerDocument then raise EWrong_Document_Err.create('Wrong document error.'); if not (arg.NodeType in FAllowedNodeTypes) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); if assigned(arg.parentNode) then raise EInuse_Node_Err.create('Inuse node error.'); if arg.NodeType = ntAttribute_Node then if assigned((arg as TdomAttr).OwnerElement) then if (arg as TdomAttr).OwnerElement <> FOwnerNode then raise EInuse_Attribute_Err.create('Inuse attribute error.'); if assigned(GetNamedItemNS(arg.namespaceURI,arg.localName)) then Result:= RemoveNamedItemNS(arg.namespaceURI,arg.localName) else Result:= nil; FNodeList.Add(arg); if (arg.NodeType = ntAttribute_Node) and (FOwnerNode.NodeType = ntElement_Node) then (arg as TdomAttr).FownerElement:= TdomElement(FOwnerNode); end; function TdomNamedNodeMap.RemoveNamedItemNS(const namespaceURI, localName: wideString): TdomNode; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if not FNamespaceAware then raise ENamespace_Err.create('Namespace error.'); Result:= getNamedItemNS(namespaceURI,localName); if not assigned(Result) then raise ENot_Found_Err.create('Node not found error.'); FNodeList.Remove(Result); if Result.NodeType = ntAttribute_Node then (Result as TdomAttr).FownerElement:= nil; end; //++++++++++++++++++++++++++++++ TdomNode +++++++++++++++++++++++++++++++++ constructor TdomNode.create(const aOwner: TdomDocument); begin inherited create; FDocument:= aOwner; FParentNode:= nil; FNodeListing:= TList.create; FNodeList:= TdomNodeList.create(FNodeListing); FNodeName:= ''; FNodeValue:= ''; FLocalName:= ''; FNamespaceURI:= ''; FPrefix:= ''; FNodeType:= ntUnknown; FAllowedChildTypes:= [ntElement_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node, ntProcessing_Instruction_Node, ntComment_Node, ntDocument_Type_Node, ntDocument_Fragment_Node, ntNotation_Node]; FIsReadonly:= false; FIsNamespaceNode:= false; end; destructor TdomNode.destroy; begin FNodeListing.free; FNodeList.free; inherited destroy; end; procedure TdomNode.clear; var oldChild: TdomNode; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); while hasChildNodes do begin firstChild.setIsReadonly(false); oldChild:= removeChild(firstChild); ownerDocument.FreeAllNodes(oldChild); end; end; procedure TdomNode.makeChildrenReadonly; var i: integer; begin with childnodes do for i:= 0 to pred(length) do with item(i) do begin item(i).setIsReadonly(true); item(i).makeChildrenReadonly; end; end; function TdomNode.RefersToExternalEntity: boolean; // Returns 'true', if one the TdomNode's children or grandchildren // (not the TdomNode itself!) is an TdomEntityReference node refering // directly or indirectly to an external Entity. Otherwise it returns // 'false'. If the target of a TdomEntityReference cannot be detected // this TdomEntityReference counts NOT as refering to an external Entity. var i: integer; node: TdomNode; contmod: TdomCMObject; ent: TdomCMEntity; begin result:= false; contmod:= OwnerDocument.contentModel; if not assigned(contmod) then exit; for i:= 0 to pred(childnodes.length) do begin node:= childnodes.item(i); case node.nodeType of ntEntity_Reference_Node: begin ent:= contMod.Entities.getNamedItem(node.nodeName); if assigned(ent) then result:= ent.refersToExternalEntity(true); end; else result:= node.RefersToExternalEntity; end; {case ...} if result then exit; end; {for ...} end; function TdomNode.HasEntRef(const EntName: wideString): boolean; var i: integer; begin result:= false; for i:= 0 to pred(childnodes.length) do with childnodes.item(i) do if (nodeType = ntEntity_Reference_Node) and (nodeName = EntName) then result:= true else if HasEntRef(EntName) then begin result:= true; exit; end; end; function TdomNode.GetNodeName: wideString; begin Result:= FNodeName; end; function TdomNode.GetNodeValue: wideString; begin Result:= FNodeValue; end; procedure TdomNode.SetNodeValue(const value: wideString); begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); FNodeValue:= value; end; function TdomNode.GetNodeType: TdomNodeType; begin Result:= FNodeType; end; function TdomNode.GetAttributes: TdomNamedNodeMap; begin Result:= nil; end; function TdomNode.GetParentNode: TdomNode; begin Result:= FParentNode; end; function TdomNode.GetDocument: TdomDocument; begin Result:= FDocument; end; function TdomNode.getTextContent: wideString; var childType: TdomNodeType; childItem: TdomNode; i,cl: integer; begin case nodeType of ntElement_Node,ntEntity_Reference_Node,ntEntity_Node,ntDocument_Fragment_Node: begin result:= ''; cl:= pred(childnodes.length); for i:= 0 to cl do begin childItem:= childnodes.item(i); childType:= childItem.nodeType; if (childType <> ntComment_Node) and (childType <> ntProcessing_Instruction_Node) then result:= concat(result,childItem.textContent); end; end; ntAttribute_Node,ntText_Node,ntCDATA_Section_Node,ntComment_Node,ntProcessing_Instruction_Node: result:= nodeValue; else result:= ''; end; end; function TdomNode.getXPathStringValue: wideString; begin case nodeType of ntElement_Node: result:= textContent; ntAttribute_Node,ntComment_Node,ntProcessing_Instruction_Node: result:= nodeValue; ntCDATA_Section_Node,ntEntity_Reference_Node,ntText_Node: if assigned(parentNode) then result:= parentNode.textContent else result:= textContent; ntDocument_Node: if assigned(TdomDocument(self).documentElement) then result:= TdomDocument(self).documentElement.textContent; ntXPath_Namespace_Node: result:= namespaceUri; else result:= ''; end; end; procedure TdomNode.SetPrefix(const value: wideString); begin if not IsXmlName(value) then raise EInvalid_Character_Err.create('Invalid character error.'); if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if not IsXmlPrefix(value) then raise ENamespace_Err.create('Namespace error.'); if namespaceURI = '' then raise ENamespace_Err.create('Namespace error.'); if (value = 'xml') and (namespaceURI <> 'http://www.w3.org/XML/1998/namespace') then raise ENamespace_Err.create('Namespace error.'); if self.NodeType = ntAttribute_Node then begin if (value = 'xmlns') and not (namespaceURI ='http://www.w3.org/2000/xmlns/') then raise ENamespace_Err.create('Namespace error.'); if NodeName = 'xmlns' then raise ENamespace_Err.create('Namespace error.'); end; FPrefix:= value; FNodeName:= concat(value,':',localName); end; procedure TdomNode.doAttrModified(originalTarget: TdomNode; attrChange: TdomAttrChange; prevValue, newValue: wideString; relatedAttr: TdomAttr); begin try if assigned(FOnAttrModified) then FOnAttrModified(self,originalTarget,attrChange,prevValue,newValue,relatedAttr); finally if assigned(FParentNode) then FParentNode.doAttrModified(originalTarget,attrChange,prevValue,newValue,relatedAttr); end; end; procedure TdomNode.doCharacterDataModified(originalTarget: TdomNode; prevValue, newValue: wideString); begin try if assigned(FOnCharacterDataModified) then FOnCharacterDataModified(self,originalTarget,prevValue,newValue); finally if assigned(FParentNode) then FParentNode.doCharacterDataModified(originalTarget,prevValue,newValue); end; end; procedure TdomNode.doNodeInserted(originalTarget: TdomNode); begin try if assigned(FOnNodeInserted) then FOnNodeInserted(self,originalTarget); finally if assigned(FParentNode) then FParentNode.doNodeInserted(originalTarget); end; end; procedure TdomNode.doNodeInsertedIntoDocument(originalTarget: TdomNode); var i: integer; begin try if assigned(FOnNodeInsertedIntoDocument) then FOnNodeInsertedIntoDocument(self,originalTarget); finally for i:= 0 to pred(childNodes.length) do childNodes.item(i).doNodeInsertedIntoDocument(originalTarget); end; end; procedure TdomNode.doNodeRemoved(originalTarget: TdomNode); begin try if assigned(FOnNodeRemoved) then FOnNodeRemoved(self,originalTarget); finally if assigned(FParentNode) then FParentNode.doNodeRemoved(originalTarget); end; end; procedure TdomNode.doNodeRemovedFromDocument(originalTarget: TdomNode); var i: integer; begin try if assigned(FOnNodeRemovedFromDocument) then FOnNodeRemovedFromDocument(self,originalTarget); finally for i:= 0 to pred(childNodes.length) do childNodes.item(i).doNodeRemovedFromDocument(originalTarget); end; end; function TdomNode.getBaseUri: wideString; var attr: TdomAttr; UriAnalyzer: TUriWideStrAnalyzer; uri1,uri2: wideString; begin case nodeType of ntElement_Node: begin if TdomElement(self).attributes.namespaceAware then attr:= TdomElement(self).getAttributeNodeNS('http://www.w3.org/XML/1998/namespace','base') else attr:= TdomElement(self).getAttributeNode('xml:base'); if assigned(attr) then begin uri1:= attr.value; UriAnalyzer:= TUriWideStrAnalyzer.create; try UriAnalyzer.setUriReference(uri1); if UriAnalyzer.HasUriScheme then begin // absolute URI --> we are done result:= attr.value; end else begin uri2:= attr.baseUri; resolveRelativeUriWideStr(uri2,uri1,result); end; finally UriAnalyzer.free; end; end else begin if assigned(parentNode) then result:= parentNode.baseUri else result:= ''; end; {if ... else ...} end; ntText_Node,ntCDATA_Section_Node,ntEntity_Reference_Node, ntProcessing_Instruction_Node,ntComment_Node,ntDocument_Type_Node: if assigned(parentNode) then result:= parentNode.baseUri else result:= ''; ntAttribute_Node: begin result:= ''; if assigned(TdomAttr(self).ownerElement) then begin if ( (namespaceURI = 'http://www.w3.org/XML/1998/namespace') and ( localName = 'base') ) or ( (namespaceURI = '') and ( nodeName = 'xml:base') ) then begin if assigned(TdomAttr(self).ownerElement.parentNode) then result:= TdomAttr(self).ownerElement.parentNode.baseUri; end else begin if assigned(TdomAttr(self).ownerElement) then result:= TdomAttr(self).ownerElement.baseUri; end; end; end; ntEntity_Node,ntNotation_Node: result:= ownerDocument.baseUri; else result:= ''; end; end; function TdomNode.sendErrorNotification(const xmlErrorType: TXmlErrorType; const relNode: TdomNode): boolean; // Used to centralize code for sending error notifications to the DomImplementation. // Usually used during validation. var domImpl: TDomImplementation; error: TdomError; uri: wideString; begin if assigned(ownerDocument) then begin domImpl:= ownerDocument.domImplementation; uri:= ownerDocument.systemId; end else domImpl:= nil; error:= TdomError.create(xmlErrorType,-1,-1,-1,-1,-1,uri,nil,relNode,''); try if assigned(domImpl) then begin result:= domImpl.handleError(domImpl,error); end else if error.severity = DOM_SEVERITY_FATAL_ERROR then result:= false else result:= true; finally error.free; end; end; procedure TdomNode.setIsReadonly(const value: boolean); begin FIsReadonly:= value; end; function TdomNode.GetChildNodes: TdomNodeList; begin Result:= FNodeList; end; function TdomNode.GetFirstChild: TdomNode; begin if FNodeListing.count = 0 then Result:= nil else Result:= TdomNode(FNodeListing.First); end; function TdomNode.GetLastChild: TdomNode; begin if FNodeListing.count = 0 then Result:= nil else Result:= TdomNode(FNodeListing.Last); end; function TdomNode.GetPreviousSibling: TdomNode; begin if assigned(ParentNode) then Result:= ParentNode.ChildNodes.Item(ParentNode.ChildNodes.IndexOf(Self)-1) else Result:= nil; end; function TdomNode.GetNextSibling: TdomNode; begin if assigned(ParentNode) then Result:= ParentNode.ChildNodes.Item(ParentNode.ChildNodes.IndexOf(Self)+1) else Result:= nil; end; function TdomNode.insertBefore(const newChild, refChild: TdomNode): TdomNode; begin if not assigned(newChild) then raise ENot_Supported_Err.create('Not supported error.'); if not (newChild.NodeType in FAllowedChildTypes) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); if OwnerDocument <> newChild.OwnerDocument then raise EWrong_Document_Err.create('Wrong document error.'); if IsAncestor(newChild) or (newChild = self) or (newChild = refChild ) // Test for circularity then raise EHierarchy_Request_Err.create('Hierarchy request error.'); if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if assigned(newChild.ParentNode) then if newChild.ParentNode.isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if assigned(refChild) then if FNodeListing.IndexOf(refChild) = -1 then raise ENot_Found_Err.create('Node not found error.'); Result:= newChild; if NewChild is TdomDocumentFragment then begin while NewChild.HasChildNodes do insertBefore(newChild.ChildNodes.Item(0),refChild) end else begin if assigned(newChild.parentNode) then newChild.parentNode.RemoveChild(newChild); if assigned(refChild) then FNodeListing.Insert(FNodeListing.IndexOf(refChild),newChild) else FNodeListing.Add(newChild); with newChild do begin FParentNode:= self; doNodeInserted(newChild); doNodeInsertedIntoDocument(newChild); end; end; end; function TdomNode.appendChild(const newChild: TdomNode): TdomNode; begin if not assigned(newChild) then raise ENot_Supported_Err.create('Not supported error.'); if not (newChild.NodeType in FAllowedChildTypes) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); if OwnerDocument <> newChild.OwnerDocument then raise EWrong_Document_Err.create('Wrong document error.'); if IsAncestor(newChild) or (newChild = self) // Test for circularity then raise EHierarchy_Request_Err.create('Hierarchy request error.'); if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if assigned(newChild.ParentNode) then if newChild.ParentNode.isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); Result:= newChild; if NewChild is TdomDocumentFragment then while NewChild.HasChildNodes do appendChild(newChild.ChildNodes.Item(0)) else begin if assigned(newChild.parentNode) then newChild.parentNode.RemoveChild(newChild); FNodeListing.Add(newChild); with newChild do begin FParentNode:= self; doNodeInserted(newChild); doNodeInsertedIntoDocument(newChild); end; end; end; function TdomNode.removeChild(const oldChild: TdomNode): TdomNode; begin if not assigned(oldChild) then raise ENot_Supported_Err.create('Not supported error.'); if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if FNodeListing.IndexOf(oldChild) = -1 then raise ENot_Found_Err.create('Node not found error.'); with oldChild do begin doNodeRemoved(oldChild); doNodeRemovedFromDocument(oldChild); end; OwnerDocument.FindNewReferenceNodes(oldChild); Result:= oldChild; FNodeListing.Remove(oldChild); OldChild.FParentNode:= nil; end; function TdomNode.replaceChild(const newChild, oldChild: TdomNode): TdomNode; var refChild: TdomNode; begin if not ( assigned(newChild) and assigned(oldChild) ) then raise ENot_Supported_Err.create('Not supported error.'); if not (newChild.NodeType in FAllowedChildTypes) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); if OwnerDocument <> newChild.OwnerDocument then raise EWrong_Document_Err.create('Wrong document error.'); if IsAncestor(newChild) or (newChild = self) // Test for circularity then raise EHierarchy_Request_Err.create('Hierarchy request error.'); if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if assigned(newChild.ParentNode) then if newChild.ParentNode.isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if FNodeListing.IndexOf(oldChild) = -1 then raise ENot_Found_Err.create('Node not found error.'); Result:= oldChild; if newChild = oldChild then exit; if assigned(newChild.parentNode) then newChild.parentNode.RemoveChild(newChild); refChild:= oldChild.NextSibling; RemoveChild(oldChild); if assigned(refChild) then insertBefore(newChild,refChild) else appendChild(newChild); end; function TdomNode.hasChildNodes: boolean; begin if FNodeListing.count = 0 then result:= false else result:= true; end; function TdomNode.cloneNode(const deep: boolean): TdomNode; begin result:= ownerDocument.importNode(self,deep); end; function TdomNode.compareTreePosition(const other: TdomNode): TdomTreePosition; procedure buildAncestorList(node: TdomNode; const ancestors: TList); begin ancestors.clear; while true do begin ancestors.insert(0,node); if assigned(node.parentNode) then begin node:= node.parentNode; end else begin if node.nodeType = ntAttribute_Node then begin if assigned(TdomAttr(node).ownerElement) then node:= TdomAttr(node).ownerElement else break; end else break; end; {if ... else ...} end; {while ...} end; var selfAncestors, otherAncestors: TList; i: integer; nodes: TdomNodeList; begin if not assigned(other) then raise ENot_Supported_Err.create('Not supported error.'); if other = self then begin result:= [Tree_Position_Equivalent,Tree_Position_Same_Node]; exit; end; selfAncestors:= TList.create; otherAncestors:= TList.create; try buildAncestorList(self,selfAncestors); buildAncestorList(other,otherAncestors); // Disconnected? if selfAncestors[0] <> otherAncestors[0] then begin result:= [Tree_Position_Disconnected]; exit; end; // Reduce list to the last common ancestor: selfAncestors.Add(nil); // Add stop-nil otherAncestors.Add(nil); // Add stop-nil while selfAncestors[1] = otherAncestors[1] do begin selfAncestors.Delete(0); otherAncestors.Delete(0); // Remark: No run over, because 'self' and 'other' are not identical. end; // Is 'other' ancestor? if otherAncestors.count = 2 then begin // Remark: 2, because 'other' and nil are in the list. result:= [Tree_Position_Ancestor,Tree_Position_Preceding]; exit; end; // Is 'other' descendant? if selfAncestors.count = 2 then begin result:= [Tree_Position_Descendant,Tree_Position_Following]; exit; end; // Attributes involved? if (TdomNode(selfAncestors[1]).nodeType = ntAttribute_Node) then begin if (TdomNode(otherAncestors[1]).nodeType = ntAttribute_Node) then result:= [Tree_Position_Equivalent] else result:= [Tree_Position_Following]; exit; end; if (TdomNode(otherAncestors[1]).nodeType = ntAttribute_Node) then begin result:= [Tree_Position_Preceding]; exit; end; with TdomNode(selfAncestors[0]).childNodes do begin // No Attributes. Determine the order of the nodes. for i:= 0 to pred(length) do begin if item(i) = TObject(selfAncestors[1]) then begin result:= [Tree_Position_Following]; exit; end; if item(i) = TObject(otherAncestors[1]) then begin result:= [Tree_Position_Preceding]; exit; end; end; end; finally selfAncestors.free; otherAncestors.free; end; end; function TdomNode.evaluate(const expression: wideString): TdomXPathResult; var nsResolver: TdomXPathNSResolver; XPathExpression: TdomXPathExpression; begin nsResolver:= ownerDocument.createNSResolver(self); try XPathExpression:= ownerDocument.createExpression(expression,nsResolver); try result:= XPathExpression.evaluate(self,XPATH_ANY_TYPE,nil); finally ownerDocument.freeExpression(XPathExpression); end; finally ownerDocument.freeNSResolver(nsResolver); end; end; function TdomNode.findFirstChildElement: TdomElement; var nodeToTest: TdomNode; begin result:= nil; nodeToTest:= firstChild; while assigned(nodeToTest) do begin if nodeToTest.nodeType = ntElement_Node then begin result:= (nodeToTest as TdomElement); exit; end; nodeToTest:= nodeToTest.nextSibling; end; end; function TdomNode.findLastChildElement: TdomElement; var nodeToTest: TdomNode; begin result:= nil; nodeToTest:= lastChild; while assigned(nodeToTest) do begin if nodeToTest.nodeType = ntElement_Node then begin result:= (nodeToTest as TdomElement); exit; end; nodeToTest:= nodeToTest.previousSibling; end; end; function TdomNode.findNextSiblingElement: TdomElement; var nodeToTest: TdomNode; begin result:= nil; nodeToTest:= nextSibling; while assigned(nodeToTest) do begin if nodeToTest.nodeType = ntElement_Node then begin result:= (nodeToTest as TdomElement); exit; end; nodeToTest:= nodeToTest.nextSibling; end; end; function TdomNode.findParentElement: TdomElement; var nodeToTest: TdomNode; begin result:= nil; nodeToTest:= parentNode; while assigned(nodeToTest) do begin if nodeToTest.nodeType = ntElement_Node then begin result:= (nodeToTest as TdomElement); exit; end; nodeToTest:= nodeToTest.parentNode; end; end; function TdomNode.findPreviousSiblingElement: TdomElement; var nodeToTest: TdomNode; begin result:= nil; nodeToTest:= previousSibling; while assigned(nodeToTest) do begin if nodeToTest.nodeType = ntElement_Node then begin result:= (nodeToTest as TdomElement); exit; end; nodeToTest:= nodeToTest.previousSibling; end; end; function TdomNode.getFirstChildElement(const name: wideString): TdomElement; var nodeToTest: TdomNode; begin result:= nil; nodeToTest:= firstChild; while assigned(nodeToTest) do begin if (nodeToTest.nodeType = ntElement_Node) and (nodeToTest.nodeName = name) then begin result:= (nodeToTest as TdomElement); exit; end; nodeToTest:= nodeToTest.nextSibling; end; end; function TdomNode.getFirstChildElementNS(const namespaceURI, localName: wideString): TdomElement; var nodeToTest: TdomNode; begin result:= nil; nodeToTest:= firstChild; while assigned(nodeToTest) do begin if (nodeToTest.nodeType = ntElement_Node) and (nodeToTest.namespaceURI = namespaceURI) and (nodeToTest.localName = localName) then begin result:= (nodeToTest as TdomElement); exit; end; nodeToTest:= nodeToTest.nextSibling; end; end; function TdomNode.getLastChildElement(const name: wideString): TdomElement; var nodeToTest: TdomNode; begin result:= nil; nodeToTest:= lastChild; while assigned(nodeToTest) do begin if (nodeToTest.nodeType = ntElement_Node) and (nodeToTest.nodeName = name) then begin result:= (nodeToTest as TdomElement); exit; end; nodeToTest:= nodeToTest.previousSibling; end; end; function TdomNode.getLastChildElementNS(const namespaceURI, localName: wideString): TdomElement; var nodeToTest: TdomNode; begin result:= nil; nodeToTest:= lastChild; while assigned(nodeToTest) do begin if (nodeToTest.nodeType = ntElement_Node) and (nodeToTest.namespaceURI = namespaceURI) and (nodeToTest.localName = localName) then begin result:= (nodeToTest as TdomElement); exit; end; nodeToTest:= nodeToTest.previousSibling; end; end; function TdomNode.getNextSiblingElement(const name: wideString): TdomElement; var nodeToTest: TdomNode; begin result:= nil; nodeToTest:= nextSibling; while assigned(nodeToTest) do begin if (nodeToTest.nodeType = ntElement_Node) and (nodeToTest.nodeName = name) then begin result:= (nodeToTest as TdomElement); exit; end; nodeToTest:= nodeToTest.nextSibling; end; end; function TdomNode.getNextSiblingElementNS(const namespaceURI, localName: wideString): TdomElement; var nodeToTest: TdomNode; begin result:= nil; nodeToTest:= nextSibling; while assigned(nodeToTest) do begin if (nodeToTest.nodeType = ntElement_Node) and (nodeToTest.namespaceURI = namespaceURI) and (nodeToTest.localName = localName) then begin result:= (nodeToTest as TdomElement); exit; end; nodeToTest:= nodeToTest.nextSibling; end; end; function TdomNode.getParentElement(const name: wideString): TdomElement; var nodeToTest: TdomNode; begin result:= nil; nodeToTest:= parentNode; while assigned(nodeToTest) do begin if (nodeToTest.nodeType = ntElement_Node) and (nodeToTest.nodeName = name) then begin result:= (nodeToTest as TdomElement); exit; end; nodeToTest:= nodeToTest.parentNode; end; end; function TdomNode.getParentElementNS(const namespaceURI, localName: wideString): TdomElement; var nodeToTest: TdomNode; begin result:= nil; nodeToTest:= parentNode; while assigned(nodeToTest) do begin if (nodeToTest.nodeType = ntElement_Node) and (nodeToTest.namespaceURI = namespaceURI) and (nodeToTest.localName = localName) then begin result:= (nodeToTest as TdomElement); exit; end; nodeToTest:= nodeToTest.parentNode; end; end; function TdomNode.getPreviousSiblingElement(const name: wideString): TdomElement; var nodeToTest: TdomNode; begin result:= nil; nodeToTest:= previousSibling; while assigned(nodeToTest) do begin if (nodeToTest.nodeType = ntElement_Node) and (nodeToTest.nodeName = name) then begin result:= (nodeToTest as TdomElement); exit; end; nodeToTest:= nodeToTest.previousSibling; end; end; function TdomNode.getPreviousSiblingElementNS(const namespaceURI, localName: wideString): TdomElement; var nodeToTest: TdomNode; begin result:= nil; nodeToTest:= previousSibling; while assigned(nodeToTest) do begin if (nodeToTest.nodeType = ntElement_Node) and (nodeToTest.namespaceURI = namespaceURI) and (nodeToTest.localName = localName) then begin result:= (nodeToTest as TdomElement); exit; end; nodeToTest:= nodeToTest.previousSibling; end; end; function TdomNode.isAncestor(const AncestorNode: TdomNode): boolean; var NewAncestor: TdomNode; List1: TList; begin Result:= false; NewAncestor:= ParentNode; List1:= TList.create; List1.clear; try while assigned(NewAncestor) do begin {Ciculation test:} if List1.IndexOf(NewAncestor) > -1 then raise EHierarchy_Request_Err.create('Hierarchy request error.'); List1.Add(NewAncestor); if NewAncestor = AncestorNode then begin Result:= true; break; end; NewAncestor:= NewAncestor.ParentNode; end; finally List1.free; end; end; procedure TdomNode.normalize; var i: integer; begin for i:= 0 to ChildNodes.Length-1 do ChildNodes.Item(i).normalize; end; function TdomNode.supports(const feature, version: wideString): boolean; var VersionStr: string; begin Result:= false; VersionStr:= WideCharToString(PWideChar(feature)); if (WideCharToString(PWideChar(version))='1.0') or (WideCharToString(PWideChar(version))='') then begin if (CompareText(VersionStr,'XML')=0) then Result:= true; end else begin if (WideCharToString(PWideChar(version))='2.0') then begin if (CompareText(VersionStr,'XML')=0) then Result:= true; end; {if ...} end; {if ... else ...} end; function TdomNode.validate2: boolean; begin raise ENot_Supported_Err.create('Not supported error.'); end; function TdomNode.validateIDREFS: boolean; begin raise ENot_Supported_Err.create('Not supported error.'); end; function TdomNode.resolveEntityReferences(const opt: TdomEntityResolveOption): boolean; var i: integer; ok: boolean; begin result:= true; for i:= 0 to pred(ChildNodes.Length) do begin ok:= ChildNodes.Item(i).resolveEntityReferences(opt); if not ok then result:= false; end; end; //+++++++++++++++++++++++++ TdomCharacterData ++++++++++++++++++++++++++++ constructor TdomCharacterData.create(const aOwner: TdomDocument); begin inherited create(aOwner); FAllowedChildTypes:= []; end; function TdomCharacterData.getData: wideString; begin Result:= NodeValue; end; procedure TdomCharacterData.setData(const value: wideString); var prevValue: wideString; begin prevValue:= NodeValue; NodeValue:= value; doCharacterDataModified(self,prevValue,value); end; function TdomCharacterData.getLength: integer; begin Result:= System.Length(Data); end; function TdomCharacterData.substringData(const offset, count: integer):wideString; var len: integer; begin if(offset < 0) or (offset > Length) or (count < 0) then raise EIndex_Size_Err.create('Index size error.'); // Make sure, that the length of the wideString is not // exeeded, when using count and offset: len:= Length-Offset; if count < len then len:= count; setString(Result,PWideChar(Data)+Offset,len); end; procedure TdomCharacterData.appendData(const arg: wideString); begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); Data:= concat(Data,arg); end; procedure TdomCharacterData.insertData(const offset: integer; const arg: wideString); begin ReplaceData(offset,0,arg); end; procedure TdomCharacterData.deleteData(const offset, count: integer); begin ReplaceData(offset,count,''); end; procedure TdomCharacterData.replaceData(const offset, count: integer; const arg: wideString); var len: integer; Data1,Data2:wideString; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if (offset < 0) or (offset > Length) or (count < 0) then raise EIndex_Size_Err.create('Index size error.'); // Make sure, that the length of the wideString is not // exeeded, when using count and offset: len:= Length-Offset; if count < len then len:= count; Data1:= SubstringData(0,offset); Data2:= SubstringData(offset+len,Length-offset-len); Data:= concat(Data1,arg,Data2); end; // +++++++++++++++++++++++++++++ TdomAttr +++++++++++++++++++++++++++++ constructor TdomAttr.create(const aOwner: TdomDocument; const name: wideString; const spcfd: boolean); begin if not IsXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FNodeName:= name; FNodeValue:= ''; FNodeType:= ntAttribute_Node; FOwnerElement:= nil; FSpecified:= Spcfd; FAllowedChildTypes:= [ntText_Node, ntEntity_Reference_Node, ntDocument_Fragment_Node]; end; constructor TdomAttr.createNS(const aOwner: TdomDocument; const anamespaceURI, qualifiedName: wideString; const spcfd: boolean); var locName,prfx: wideString; begin if not xmlExtractPrefixAndLocalName(qualifiedName,prfx,locName) then begin if not IsXmlName(qualifiedName) then raise EInvalid_Character_Err.create('Invalid character error.') else raise ENamespace_Err.create('Namespace error.'); end; if ( ((prfx = 'xmlns') or (qualifiedName = 'xmlns')) and not (namespaceURI ='http://www.w3.org/2000/xmlns/') ) then raise ENamespace_Err.create('Namespace error.'); if (namespaceURI = '') and (prfx <> '') then raise ENamespace_Err.create('Namespace error.'); if (prfx = 'xml') and (namespaceURI <> 'http://www.w3.org/XML/1998/namespace') then raise ENamespace_Err.create('Namespace error.'); inherited create(aOwner); FNodeName:= qualifiedName; FNamespaceURI:= namespaceURI; FPrefix:= prfx; FLocalName:= locName; FIsNamespaceNode:= true; FNodeValue:= ''; FNodeType:= ntAttribute_Node; FOwnerElement:= nil; FSpecified:= Spcfd; FAllowedChildTypes:= [ntText_Node, ntEntity_Reference_Node, ntDocument_Fragment_Node]; end; procedure TdomAttr.normalize; var PrevNode, CurrentNode: TdomNode; i: integer; begin {normalize text:} PrevNode:= nil; i:= ChildNodes.Length; while i>0 do begin Dec(i); CurrentNode:= ChildNodes.Item(i); if (CurrentNode.NodeType = ntText_Node) then begin if (Assigned(PrevNode)) and (PrevNode.NodeType = ntText_Node) then begin (CurrentNode as TdomText).AppendData((PrevNode as TdomText).Data); removeChild(PrevNode); PrevNode.OwnerDocument.FreeAllNodes(PrevNode); end; end else // no text node, then normalize CurrentNode.normalize; PrevNode:=CurrentNode; end; end; function TdomAttr.GetName: wideString; begin Result:= NodeName; end; function TdomAttr.GetSpecified: boolean; begin Result:= FSpecified; end; function TdomAttr.GetNodeValue: wideString; begin Result:= getValue; end; function TdomAttr.getLiteralValue: wideString; var i, j: integer; child: TdomNode; content: TdomCustomStr; textData: wideString; begin content:= TdomCustomStr.create; try for i:= 0 to pred(childNodes.length) do begin child:= childNodes.item(i); case child.NodeType of ntText_Node: begin textData:= (child as TdomText).data; for j:= 1 to length(textData) do begin case ord(textData[j]) of 38: content.addWideString('&'); // Ampersand ('&') 34: content.addWideString('"'); // Double quote ('"') 60: content.addWideString('<'); // Less than ('<') else content.addWideChar(textData[j]); end; end; end; ntEntity_Reference_Node: begin content.addWideChar('&'); content.addWideString(child.nodeName); content.addWideChar(';'); end; end; end; {for ...} result:= content.value; finally content.free; end; end; procedure TdomAttr.SetNodeValue(const value: wideString); begin setValue(value); end; function TdomAttr.GetValue: wideString; procedure FurtherAttrNormalization(var S: wideString); const DOUBLESPACE: wideString = #$20#$20; var nPos: integer; dummy: wideString; begin repeat nPos := Pos(DOUBLESPACE, S); if nPos > 0 then Delete(S, nPos, 1); until nPos = 0; dummy:= S; s:= XMLTruncSpace(dummy); end; var i: integer; EntName: wideString; Entity: TdomCMEntity; CMAttr: TdomCMAttribute; child: TdomNode; begin Result:=''; for i:= 0 to ChildNodes.Length -1 do begin child:= ChildNodes.item(i); case child.NodeType of ntText_Node: Result:= Concat(Result,(child as TdomText).Data); ntEntity_Reference_Node: begin Entity:= nil; EntName:= (child as TdomEntityReference).NodeName; if (EntName='lt') then begin Result:= Concat(Result,wideString('<')) end else if (EntName='gt') then begin Result:= Concat(Result,#62) end else if (EntName='amp') then begin Result:= Concat(Result,wideString('&')) end else if (EntName='apos') then begin Result:= Concat(Result,#39) end else if (EntName='quot') then begin Result:= Concat(Result,#34) end else begin if assigned(OwnerDocument) then if assigned(OwnerDocument.contentModel) then Entity:= OwnerDocument.contentModel.entities.getNamedItem(EntName); if assigned(Entity) then begin Result:= Concat(Result,Entity.normalizedValue) end else raise EConvertError.create('Invalid entity reference error.'); end; end; end; end; {for ...} // Further attribute normalization: if assigned(OwnerElement) then if assigned(OwnerDocument) then if assigned(OwnerDocument.contentModel) then begin CMAttr:= OwnerDocument.contentModel.attributes.getNamedItem(OwnerElement.nodeName,nodename); if assigned(CMAttr) then if not IsXmlStringType(CMAttr.attributeType) then FurtherAttrNormalization(result); end; end; procedure TdomAttr.SetValue(const value: wideString); var newTextNode: TdomText; oldChild: TdomNode; prevValue: wideString; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); prevValue:= nodeValue; while HasChildNodes do begin FirstChild.setIsReadonly(false); oldChild:= RemoveChild(FirstChild); ownerDocument.FreeAllNodes(oldChild); end; newTextNode:= OwnerDocument.CreateTextNode(value); appendChild(newTextNode); if assigned(FOwnerElement) then FOwnerElement.doAttrModified(FOwnerElement,AC_MODIFICATION,prevValue,value,self); end; function TdomAttr.GetOwnerElement: TdomElement; begin Result:= FOwnerElement; end; function TdomAttr.GetParentNode: TdomNode; begin Result:= nil; end; function TdomAttr.GetPreviousSibling: TdomNode; begin Result:= nil; end; function TdomAttr.GetNextSibling: TdomNode; begin Result:= nil; end; function TdomAttr.validate2: boolean; function isValidENTITY(const entitiesList: TdomNamedCMEntityMap; const entityValue: wideString): boolean; begin if not assigned(entitiesList.getNamedItem(entityValue)) then begin result:= false; sendErrorNotification(ET_TARGET_UNPARSED_ENTITY_NOT_FOUND,self); end else result:= true; end; const SPACE: WideChar = #$20; LT: WideChar = #60; // '<' var i,startIndex,indexCount: integer; ok, typeMismatch: boolean; attriValue, AType: wideString; Attri: TdomCMAttribute; begin result:= true; try attriValue:= value; except // VC: Entity declared (XML 1.0, § 4.1) result:= false; sendErrorNotification(ET_ENTITY_DECL_NOT_FOUND,self); exit; // Necessary because 'attriValue' will be used again in the next tests. end; // WFC: No < in Attribute Values (XML 1.0, § 3.1) if pos(LT,attriValue) > 0 then begin result:= false; sendErrorNotification(ET_LT_IN_ATTRIBUTE_VALUE,self); end; // WFC: No External Entity Reference (XML 1.0, § 3.1) if refersToExternalEntity then begin result:= false; sendErrorNotification(ET_ATTRIBUTE_VALUE_REFERS_TO_EXTERNAL_ENTITY,self); end; // VC: Attribute value Type (XML 1.0, § 3.1) if assigned(OwnerDocument.contentModel) and assigned(OwnerElement) then begin Attri:= (OwnerDocument.contentModel.attributes.GetNamedItem(OwnerElement.NodeName,NodeName) as TdomCMAttribute); if not assigned(Attri) then begin result:= false; sendErrorNotification(ET_ATTRIBUTE_DEFINITION_NOT_FOUND,self); end else begin AType:= Attri.AttributeType; TypeMismatch:= false; If AType = '' then begin ok:= false; with attri do begin for i:= 0 to pred(ChildNodes.length) do begin if ChildNodes.item(i).NodeName = attriValue then begin ok:= true; break; end; end; end; {with ...} TypeMismatch:= not ok; // VC: Enumaration (XML 1.0, § 3.3.1) end else if AType = 'ID' then begin if not isXMLName(attriValue) then TypeMismatch:= true; // VC: Entity (XML 1.0, § 3.3.1) try OwnerDocument.IDs.addObject(attriValue,self); except // VC: ID (XML 1.0, § 3.3.1) on EStringListError do begin result:= false; sendErrorNotification(ET_DUPLICATE_ID_VALUE,self); end; end; end else if AType = 'ENTITY' then begin // VC: Entity (XML 1.0, § 3.3.1) if not isXMLName(attriValue) then begin TypeMismatch:= true end else begin if not isValidEntity(ownerDocument.contentModel.entities,attriValue) then result:= false; end; end else if AType = 'ENTITIES' then begin // VC: Entity (XML 1.0, § 3.3.1) if not isXMLNames(attriValue) then begin TypeMismatch:= true; end else begin startIndex:= 1; indexCount:= 0; for i:= 1 to length(attriValue) do begin if attriValue[i] = SPACE then begin if not isValidEntity(ownerDocument.contentModel.entities,copy(attriValue,startIndex,IndexCount)) then result:= false; startIndex:= succ(i); indexCount:= 0; end else inc(indexCount); end; if not isValidEntity(ownerDocument.contentModel.entities,copy(attriValue,startIndex,IndexCount)) then result:= false; end; end else if AType = 'NMTOKEN' then begin if not isXmlNmtoken(attriValue) then TypeMismatch:= true; // VC: name Token (XML 1.0, § 3.3.1) end else if AType = 'NMTOKENS' then begin if not isXmlNmtokens(attriValue) then TypeMismatch:= true; // VC: name Token (XML 1.0, § 3.3.1) end; if TypeMismatch then begin result:= false; sendErrorNotification(ET_ATTRIBUTE_TYPE_MISMATCH,self); end; end; end else begin result:= false; sendErrorNotification(ET_ATTRIBUTE_DEFINITION_NOT_FOUND,self); end; {if assigned(OwnerDocument.contentModel) ... else ... end} end; function TdomAttr.validateIDREFS: boolean; function isValidIDREF(const idList: TdomWideStringList; const idrefValue: wideString): boolean; var dummyIndex: integer; begin if not idList.find(idrefValue,dummyIndex) then begin result:= false; sendErrorNotification(ET_TARGET_ID_VALUE_NOT_FOUND,self); end else result:= true; end; const SPACE: WideChar = #$20; var i, startIndex, indexCount: integer; attrivalue, AType: wideString; TypeMismatch: boolean; Attri: TdomCMAttribute; begin result:= true; try attriValue:= value; except // VC: Entity declared (XML 1.0, § 4.1) result:= false; sendErrorNotification(ET_ENTITY_DECL_NOT_FOUND,self); exit; // Necessary because 'attriValue' would instead be used again in the next tests. end; // VC: IDREF (XML 1.0, § 3.3.1) TypeMismatch:= false; if assigned(OwnerDocument.contentModel) and assigned(OwnerElement) then begin Attri:= (OwnerDocument.contentModel.attributes.GetNamedItem(OwnerElement.NodeName,NodeName) as TdomCMAttribute); AType:= Attri.AttributeType; if AType = 'IDREF' then begin if not isXMLName(attriValue) then TypeMismatch:= true else begin if not isValidIDREF(ownerDocument.IDs,attriValue) then result:= false; end; end else if AType = 'IDREFS' then begin if not isXMLNames(attriValue) then TypeMismatch:= true else begin startIndex:= 1; indexCount:= 0; for i:= 1 to length(attriValue) do begin if attriValue[i] = SPACE then begin if not isValidIDREF(ownerDocument.IDs,copy(attriValue,startIndex,IndexCount)) then result:= false; startIndex:= succ(i); indexCount:= 0; end else inc(indexCount); end; if not isValidIDREF(ownerDocument.IDs,copy(attriValue,startIndex,IndexCount)) then result:= false; end; end; end; if TypeMismatch then begin result:= false; sendErrorNotification(ET_ATTRIBUTE_TYPE_MISMATCH,self); end; end; function TdomAttr.resolveEntityReferences(const opt: TdomEntityResolveOption): boolean; var i: integer; s, childName: wideString; child: TdomNode; cmEnt: TdomCMEntity; parser: TXmlToDomParser; begin result:= true; parser:= TXmlToDomParser.create(nil); try case opt of erReplace: begin try S:= literalValue; clear; if S <> '' then parser.docWideStringToDom(S,'','',self); except result:= false; end; end; erExpand: begin // xxx Shouldn't that be removed at all ??? for i:= 0 to pred(childnodes.length) do begin child:= childnodes.item(i); if child.nodeType = ntEntity_Reference_Node then begin child.clear; cmEnt:= (child as TdomEntityReference).correspondingCMEntity; if assigned(cmEnt) then begin try S:= cmEnt.normalizedValue; if S <> '' then parser.docWideStringToDom(S,'','',child); except result:= false; end; end else begin childName:= child.nodeName; if (childName='lt') then begin child.appendChild(ownerDocument.CreateTextNode(#60)) end else if (childName='gt') then begin child.appendChild(ownerDocument.CreateTextNode(#62)) end else if (childName='amp') then begin child.appendChild(ownerDocument.CreateTextNode(#38)) end else if (childName='apos') then begin child.appendChild(ownerDocument.CreateTextNode(#39)) end else if (childName='quot') then begin child.appendChild(ownerDocument.CreateTextNode(#34)) end else result:= false; end; {if assigned(cmEnt) ...} // xxx setting the readonly property is missing here! end; end; end; end; finally parser.free; end; end; //++++++++++++++++++++++++++++ TdomElement ++++++++++++++++++++++++++++++++ constructor TdomElement.create(const aOwner: TdomDocument; const tagName: wideString); begin if not IsXmlName(tagName) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FNodeName:= tagName; FNodeValue:= ''; FNodeType:= ntElement_Node; FAttributeListing:= TList.create; FCreatedElementsNodeLists:= TList.create; FCreatedElementsNodeListNSs:= TList.create; FAttributeList:= TdomNamedNodeMap.create(aOwner,self,FAttributeListing,[ntAttribute_Node]); FAllowedChildTypes:= [ntElement_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node, ntProcessing_Instruction_Node, ntComment_Node, ntDocument_Fragment_Node]; end; constructor TdomElement.createNS(const aOwner: TdomDocument; const anamespaceURI, qualifiedName: wideString); var locName,prfx: wideString; begin if not xmlExtractPrefixAndLocalName(qualifiedName,prfx,locName) then begin if not IsXmlName(qualifiedName) then raise EInvalid_Character_Err.create('Invalid character error.') else raise ENamespace_Err.create('Namespace error.'); end; if (namespaceURI = '') and (prfx <> '') then raise ENamespace_Err.create('Namespace error.'); if (prfx = 'xml') and (namespaceURI <> 'http://www.w3.org/XML/1998/namespace') then raise ENamespace_Err.create('Namespace error.'); inherited create(aOwner); FNodeName:= qualifiedName; FNamespaceURI:= anamespaceURI; FPrefix:= prfx; FLocalName:= locName; FIsNamespaceNode:= true; FNodeValue:= ''; FNodeType:= ntElement_Node; FAttributeListing:= TList.create; FCreatedElementsNodeLists:= TList.create; FCreatedElementsNodeListNSs:= TList.create; FAttributeList:= TdomNamedNodeMap.create(aOwner,self,FAttributeListing,[ntAttribute_Node]); FAllowedChildTypes:= [ntElement_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node, ntProcessing_Instruction_Node, ntComment_Node, ntDocument_Fragment_Node]; end; destructor TdomElement.destroy; var i: integer; begin FAttributeList.free; FAttributeListing.free; if assigned(FCreatedElementsNodeLists) then for i := 0 to pred(FCreatedElementsNodeLists.Count) do TdomElementsNodeList(FCreatedElementsNodeLists[i]).free; if assigned(FCreatedElementsNodeListNSs) then for i := 0 to pred(FCreatedElementsNodeListNSs.Count) do TdomElementsNodeListNS(FCreatedElementsNodeListNSs[i]).free; FCreatedElementsNodeLists.free; FCreatedElementsNodeListNSs.free; inherited destroy; end; procedure TdomElement.setNodeValue(const value: wideString); begin end; procedure TdomElement.setIsReadonly(const value: boolean); begin inherited setIsReadonly(value); Attributes.setIsReadonly(value); end; function TdomElement.getTagName: wideString; begin Result:= NodeName; end; function TdomElement.getAttributes: TdomNamedNodeMap; begin Result:= FAttributeList; end; function TdomElement.getAttribute(const name: wideString): wideString; begin if Attributes.NamespaceAware then raise ENamespace_Err.create('Namespace error.'); if not assigned(GetAttributeNode(name)) then result:= '' else result:= (Attributes.GetNamedItem(name) as TdomAttr).value; end; function TdomElement.setAttribute(const name, value: wideString): TdomAttr; var Attr: TdomAttr; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if Attributes.NamespaceAware then raise ENamespace_Err.create('Namespace error.'); Attr:= getAttributeNode(name); if assigned(Attr) then begin Attr.value:= value; Result:= nil; end else begin Result:= OwnerDocument.CreateAttribute(name); Result.value:= value; setAttributeNode(Result); end; end; function TdomElement.removeAttribute(const name: wideString): TdomAttr; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if Attributes.NamespaceAware then raise ENamespace_Err.create('Namespace error.'); if not assigned(GetAttributeNode(name)) then ENot_Found_Err.create('Node not found error.'); Result:= RemoveAttributeNode(GetAttributeNode(name)); end; function TdomElement.getAttributeNode(const name: wideString): TdomAttr; begin if Attributes.NamespaceAware then raise ENamespace_Err.create('Namespace error.'); Result:= TdomAttr(Attributes.GetNamedItem(name)); end; function TdomElement.setAttributeNode(const newAttr: TdomAttr): TdomAttr; var OldAttr: TdomAttr; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if Attributes.NamespaceAware then raise ENamespace_Err.create('Namespace error.'); if OwnerDocument <> newAttr.OwnerDocument then raise EWrong_Document_Err.create('Wrong document error.'); if assigned(newAttr.parentNode) and not (newAttr.OwnerElement = self) then raise EInuse_Attribute_Err.create('Inuse attribute error.'); Result:= nil; if not (newAttr.OwnerElement = self) then begin OldAttr:= (Attributes.GetNamedItem(newAttr.name) as TdomAttr); if assigned(OldAttr) then Result:= RemoveAttributeNode(OldAttr); Attributes.SetNamedItem(newAttr); doAttrModified(self,AC_ADDITION,'',newAttr.value,newAttr); end; end; function TdomElement.removeAttributeNode(const oldAttr: TdomAttr): TdomAttr; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if Attributes.indexof(oldAttr) = -1 then raise ENot_Found_Err.create('Node not found error.'); Attributes.RemoveItem(oldAttr); oldAttr.FOwnerElement:= nil; Result:= oldAttr; doAttrModified(self,AC_REMOVAL,oldAttr.value,'',oldAttr); end; function TdomElement.getElementsByTagName(const name: wideString): TdomNodeList; var i: integer; begin for i:= 0 to FCreatedElementsNodeLists.Count - 1 do if TdomElementsNodeList(FCreatedElementsNodeLists[i]).FQueryName = name then begin Result:= TdomElementsNodeList(FCreatedElementsNodeLists[i]); exit; end; Result:= TdomElementsNodeList.create(name,self); FCreatedElementsNodeLists.add(Result); end; function TdomElement.getAttributeNS(const anamespaceURI, alocalName: wideString): wideString; begin if not Attributes.NamespaceAware then raise ENamespace_Err.create('Namespace error.'); if not assigned(GetAttributeNodeNS(anamespaceURI,alocalName)) then result:= '' else result:= (Attributes.GetNamedItemNS(anamespaceURI,alocalName) as TdomAttr).value; end; function TdomElement.setAttributeNS(const anamespaceURI, qualifiedName, value: wideString): TdomAttr; var Attr: TdomAttr; prfx, alocalname: wideString; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if not Attributes.NamespaceAware then raise ENamespace_Err.create('Namespace error.'); if not xmlExtractPrefixAndLocalName(qualifiedName,prfx,alocalName) then begin if not IsXmlName(qualifiedName) then raise EInvalid_Character_Err.create('Invalid character error.') else raise ENamespace_Err.create('Namespace error.'); end; if ( ((prfx = 'xmlns') or (qualifiedName = 'xmlns')) and not (anamespaceURI ='http://www.w3.org/2000/xmlns/') ) then raise ENamespace_Err.create('Namespace error.'); if (namespaceURI = '') and (prfx <> '') then raise ENamespace_Err.create('Namespace error.'); if (prfx = 'xml') and (anamespaceURI <> 'http://www.w3.org/XML/1998/namespace') then raise ENamespace_Err.create('Namespace error.'); Attr:= getAttributeNodeNS(anamespaceURI,alocalName); if assigned(Attr) then begin Attr.FNodeName:= qualifiedName; Attr.value:= value; Result:= nil; end else begin Result:= OwnerDocument.CreateAttributeNS(anamespaceURI,qualifiedName); Result.value:= value; setAttributeNodeNS(Result); end; end; function TdomElement.removeAttributeNS(const anamespaceURI, alocalName: wideString): TdomAttr; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if not Attributes.NamespaceAware then raise ENamespace_Err.create('Namespace error.'); if not assigned(GetAttributeNodeNS(anamespaceURI,alocalName)) then ENot_Found_Err.create('Node not found error.'); Result:= RemoveAttributeNode(GetAttributeNodeNS(anamespaceURI,alocalName)); end; function TdomElement.getAttributeNodeNS(const anamespaceURI, alocalName: wideString): TdomAttr; begin if not Attributes.NamespaceAware then raise ENamespace_Err.create('Namespace error.'); Result:= TdomAttr(Attributes.GetNamedItemNS(anamespaceURI,alocalName)); end; function TdomElement.setAttributeNodeNS(const newAttr: TdomAttr): TdomAttr; var OldAttr: TdomAttr; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if not Attributes.NamespaceAware then raise ENamespace_Err.create('Namespace error.'); if OwnerDocument <> newAttr.OwnerDocument then raise EWrong_Document_Err.create('Wrong document error.'); if assigned(newAttr.parentNode) and not (newAttr.OwnerElement = self) then raise EInuse_Attribute_Err.create('Inuse attribute error.'); Result:= nil; if not (newAttr.OwnerElement = self) then begin OldAttr:= (Attributes.GetNamedItemNS(newAttr.namespaceURI,newAttr.localName) as TdomAttr); if assigned(OldAttr) then Result:= RemoveAttributeNode(OldAttr); Attributes.SetNamedItemNS(newAttr); doAttrModified(self,AC_ADDITION,'',newAttr.value,newAttr); end; end; function TdomElement.getElementsByTagNameNS(const anamespaceURI, alocalName: wideString): TdomNodeList; var i: integer; nl: TdomElementsNodeListNS; begin for i:= 0 to FCreatedElementsNodeListNSs.Count - 1 do begin nl:= TdomElementsNodeListNS(FCreatedElementsNodeListNSs[i]); if (nl.FQueryNamespaceURI = anamespaceURI) and (nl.FQueryLocalName = alocalName) then begin Result:= nl; exit; end; end; Result:= TdomElementsNodeListNS.create(anamespaceURI,alocalName,self); FCreatedElementsNodeListNSs.add(Result); end; function TdomElement.hasAttribute(const aname: wideString): boolean; begin Result:= assigned(Attributes.GetNamedItem(aname)); end; function TdomElement.hasAttributeNS(const anamespaceURI, alocalName: wideString): boolean; begin Result:= assigned(Attributes.GetNamedItemNS(anamespaceURI,alocalName)); end; procedure TdomElement.normalize; var PrevNode, CurrentNode: TdomNode; i: integer; begin {normalize text:} PrevNode:=nil; i:=ChildNodes.Length; while i>0 do begin Dec(i); CurrentNode:=ChildNodes.Item(i); if (CurrentNode.NodeType = ntText_Node) then begin if (Assigned(PrevNode)) and (PrevNode.NodeType = ntText_Node) then begin (CurrentNode as TdomText).AppendData((PrevNode as TdomText).Data); removeChild(PrevNode); PrevNode.OwnerDocument.FreeAllNodes(PrevNode); end; end else // no text node, then normalize CurrentNode.normalize; PrevNode:=CurrentNode; end; {normalize attributes:} for i:= 0 to attributes.Length-1 do attributes.item(i).normalize; end; function TdomElement.validate2: boolean; var i: integer; ok: boolean; contentModelOk: boolean; EType: TdomCMElementTypeDeclaration; PcdataChoice: TdomCMPcdataChoiceParticle; particle: TdomCMParticle; elementnames,rest: TdomWideStringList; cm: TdomCMObject; attri: TdomCMAttribute; newAttr, textAttr: TdomAttr; treeWalker: TdomTreeWalker; nodeToTest: TdomNode; isNonDeterministic: boolean; begin result:= true; cm:= OwnerDocument.contentModel; if assigned(cm) then begin // VC: Element Valid (XML 1.0, § 3) EType:= (cm.elementTypes.GetNamedItem(NodeName) as TdomCMElementTypeDeclaration); if not assigned(EType) then begin result:= false; sendErrorNotification(ET_ELEMENT_TYPE_DECL_NOT_FOUND,self); end else begin treeWalker:= ownerDocument.CreateTreeWalker(self, // Hide entity reference nodes: [ntElement_Node, ntAttribute_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Node, ntProcessing_Instruction_Node, ntComment_Node, ntDocument_Node, ntDocument_Type_Node, ntDocument_Fragment_Node, ntNotation_Node], nil, true); try case EType.ContentspecType of ctEmpty: begin nodeToTest:= treeWalker.firstChild; while assigned(nodeToTest) do begin if not ( (nodeToTest.nodeType = ntText_Node) and (nodeToTest.nodeValue = '') ) then begin result:= false; sendErrorNotification(ET_ELEMENT_DECLARED_EMPTY_HAS_CONTENT,self); break; end; nodeToTest:= treeWalker.nextSibling; end; {while ...} end; ctChildren: begin elementnames:= TdomWideStringList.create; rest:= TdomWideStringList.create; try ok:= true; nodeToTest:= treeWalker.firstChild; while assigned(nodeToTest) do begin with nodeToTest do begin case nodeType of ntElement_Node: elementnames.Add(NodeName); ntText_Node: if not (IsXmlS(nodeValue) or (nodeValue = '')) then begin ok:= false; break; end; ntProcessing_Instruction_Node,ntComment_Node:; // Do nothing --> node accepted. else begin ok:= false; break; end; end; {case ...} end; {with ...} nodeToTest:= treeWalker.nextSibling; end; {while ...} if ok then begin particle:= EType.firstChild as TdomCMParticle; contentModelOk:= particle.contentModelTest(elementnames,rest,isNonDeterministic); if isNonDeterministic then begin result:= false; sendErrorNotification(ET_NONDETERMINISTIC_ELEMENT_CONTENT_MODEL,self); end else ok:= contentModelOk and (rest.Count = 0); end; {if ok ...} finally elementnames.free; rest.free; end; if not ok then begin result:= false; sendErrorNotification(ET_ELEMENT_WITH_ILLEGAL_ELEMENT_CONTENT,self); end; {if ...} end; ctMixed: begin PcdataChoice:= EType.firstChild as TdomCMPcdataChoiceParticle; nodeToTest:= treeWalker.firstChild; while assigned(nodeToTest) do begin ok:= true; with nodeToTest do begin case nodeType of ntElement_Node: if assigned(PcdataChoice) then begin if not PcdataChoice.elementDefined(NodeName) then ok:= false; end else ok:= false; ntText_Node,ntProcessing_Instruction_Node,ntComment_Node:; // Do nothing --> node accepted. else ok:= false; end; {case ...} if not ok then begin result:= false; sendErrorNotification(ET_ELEMENT_WITH_ILLEGAL_MIXED_CONTENT,self); end; {if ...} end; {with ...} nodeToTest:= treeWalker.nextSibling; end; {while ...} end; end; {case ...} finally ownerDocument.freeTreeWalker(TreeWalker); end; {try ...} end; {if not assigned(EType) ... else ... end} with cm.attributes do begin for i:= 0 to pred(length) do begin attri:= item(i); if attri.elementName = nodeName then begin if attri.defaultDeclaration = '#REQUIRED' then begin // VC: Required Attribute (XML 1.0, § 3.3.2) if not hasAttribute(attri.attributeName) then begin result:= false; sendErrorNotification(ET_REQUIRED_ATTRIBUTE_NOT_FOUND,self); end; end else begin textAttr:= self.GetAttributeNode(attri.attributeName); if assigned(textAttr) then begin // VC: Fixed Attribute Default (XML 1.0, § 3.3.2) if attri.defaultDeclaration = '#FIXED' then begin if attri.NodeValue <> textAttr.value then begin result:= false; sendErrorNotification(ET_FIXED_ATTRIBUTE_MISMATCH,self); end; end; end else begin // set default attributes: if not (attri.defaultDeclaration = '#IMPLIED') then begin newAttr:= OwnerDocument.CreateAttribute(attri.AttributeName); newAttr.value:= attri.NodeValue; newAttr.FSpecified:= false; self.SetAttributeNode(newAttr); end; end; end; end; {if attri.elementName ...} end; {for ...} end; {with ...} end else begin result:= false; sendErrorNotification(ET_ELEMENT_TYPE_DECL_NOT_FOUND,self); end; {if assigned(cm) ... else ... end} // validate child attributes: for i:= 0 to pred(attributes.length) do if not attributes.item(i).validate2 then result:= false; // validate child nodes: for i:= 0 to pred(childnodes.length) do if not childnodes.item(i).validate2 then result:= false; end; function TdomElement.validateIDREFS: boolean; var i: integer; begin result:= true; for i:= 0 to pred(attributes.length) do if not attributes.Item(i).validateIDREFS then result:= false; end; function TdomElement.resolveEntityReferences(const opt: TdomEntityResolveOption): boolean; var i: integer; ok,hasEntRefs: boolean; S, childName: wideString; child: TdomNode; docFrag: TdomDocumentFragment; ReplText: TdomText; cmEnt: TdomCMEntity; parser: TXmlToDomParser; begin result:= true; for i:= 0 to pred(attributes.Length) do begin ok:= attributes.Item(i).resolveEntityReferences(opt); if not ok then result:= false; end; case opt of erReplace: begin parser:= TXmlToDomParser.create(nil); try parser.DOMImpl:= ownerDocument.domImplementation; hasEntRefs:= false; i:= 0; while i < ChildNodes.Length do begin child:= ChildNodes.Item(i); if child.nodeType = ntEntity_Reference_Node then begin hasEntRefs:= true; cmEnt:= (child as TdomEntityReference).correspondingCMEntity; if assigned(cmEnt) then begin try S:= cmEnt.replacementText; docFrag:= ownerDocument.CreateDocumentFragment; try if S <> '' then parser.docWideStringToDom(S,'','',docFrag); replaceChild(docFrag,child); ownerDocument.FreeAllNodes(child); dec(i); // Necessary, if an empty entity was referenced. finally ownerDocument.FreeAllNodes(TdomNode(docFrag)); end; except result:= false; end; end else begin childName:= child.nodeName; if (childName='lt') then begin ReplText:= ownerDocument.CreateTextNode(#60); replaceChild(ReplText,child); ownerDocument.FreeAllNodes(child); end else if (childName='gt') then begin ReplText:= ownerDocument.CreateTextNode(#62); replaceChild(ReplText,child); ownerDocument.FreeAllNodes(child); end else if (childName='amp') then begin ReplText:= ownerDocument.CreateTextNode(#38); replaceChild(ReplText,child); ownerDocument.FreeAllNodes(child); end else if (childName='apos') then begin ReplText:= ownerDocument.CreateTextNode(#39); replaceChild(ReplText,child); ownerDocument.FreeAllNodes(child); end else if (childName='quot') then begin ReplText:= ownerDocument.CreateTextNode(#34); replaceChild(ReplText,child); ownerDocument.FreeAllNodes(child); end else result:= false; end; {if assigned(cmEnt) ...} end else child.resolveEntityReferences(opt); inc(i); end; {while ...} finally parser.free; end; if hasEntRefs then normalize; end; erExpand: begin for i:= 0 to pred(ChildNodes.Length) do begin child:= ChildNodes.Item(i); if child.nodeType = ntEntity_Reference_Node then begin ok:= (child as TdomEntityReference).expand; if not ok then result:= false; end else child.resolveEntityReferences(opt); end; {for ...} end; end; end; //+++++++++++++++++++++++++++++ TdomText +++++++++++++++++++++++++++++++++ constructor TdomText.create(const aOwner: TdomDocument); begin inherited create(aOwner); FNodeName:= '#text'; FNodeValue:= ''; FNodeType:= ntText_Node; FAllowedChildTypes:= []; end; function TdomText.getIsWhitespaceInElementContent: boolean; var cm: TdomCMObject; EType: TdomCMElementTypeDeclaration; pNode: TdomNode; begin result:= false; if not (isXMLS(nodeValue) or (nodeValue = '')) then exit; cm:= OwnerDocument.contentModel; if assigned(cm) then begin pNode:= parentNode; while assigned(pNode) do begin case pNode.nodeType of ntElement_Node: begin EType:= (cm.elementTypes.GetNamedItem(pNode.NodeName) as TdomCMElementTypeDeclaration); if assigned(EType) then if EType.ContentspecType = ctChildren then result:= true; break; end; ntEntity_Reference_Node: pNode:= pNode.parentNode; else break; end; {case ...} end; {while ...} end; {if ...} end; function TdomText.validate2: boolean; begin result:= true; end; function TdomText.SplitText(const offset: integer): TdomText; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if(offset < 0) or (offset > Length) then raise EIndex_Size_Err.create('Index size error.'); Result:= OwnerDocument.CreateTextNode(SubstringData(offset,length-offset)); DeleteData(offset,length-offset); if assigned(ParentNode) then ParentNode.insertBefore(Result,self.NextSibling); end; //++++++++++++++++++++++++++++ TdomComment +++++++++++++++++++++++++++++++ constructor TdomComment.create(const aOwner: TdomDocument); begin inherited create(aOwner); FNodeName:= '#comment'; FNodeValue:= ''; FNodeType:= ntComment_Node; FAllowedChildTypes:= []; end; function TdomComment.validate2: boolean; begin result:= true; end; //+++++++++++++++++++++ TdomProcessingInstruction +++++++++++++++++++++++++ constructor TdomProcessingInstruction.create(const aOwner: TdomDocument; const targ: wideString); begin if not IsXmlPITarget(targ) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FNodeName:= targ; FNodeValue:= ''; FNodeType:= ntProcessing_Instruction_Node; FAllowedChildTypes:= []; end; function TdomProcessingInstruction.validate2: boolean; begin result:= true; end; function TdomProcessingInstruction.getTarget: wideString; begin Result:= FNodeName; end; function TdomProcessingInstruction.getData: wideString; begin Result:= FNodeValue; end; procedure TdomProcessingInstruction.setData(const value: wideString); var prevValue: wideString; begin prevValue:= NodeValue; NodeValue:= value; doCharacterDataModified(self,prevValue,value); end; //++++++++++++++++++++++++++ TdomCDATASection +++++++++++++++++++++++++++++ constructor TdomCDATASection.create(const aOwner: TdomDocument); begin inherited create(aOwner); FNodeName:= '#cdata-section'; FNodeValue:= ''; FNodeType:= ntCDATA_Section_Node; end; function TdomCDATASection.validate2: boolean; begin result:= true; end; //++++++++++++++++++++++++++ TdomDocumentType +++++++++++++++++++++++++++++ constructor TdomDocumentType.create(const aOwner: TdomDocument; const name, pubId, sysId, IntSubset: wideString); begin inherited create(aOwner); FNodeValue:= ''; FNodeName:= name; FPublicId:= pubId; FSystemId:= sysId; FInternalSubset:= IntSubset; FNodeType:= ntDocument_Type_Node; FAllowedChildTypes:= []; FEntitiesListing:= TList.create; FEntitiesList:= TdomNamedNodeMap.create(aOwner,self,FEntitiesListing,[ntEntity_Node]); FNotationsListing:= TList.create; FNotationsList:= TdomNamedNodeMap.create(aOwner,self,FNotationsListing,[ntNotation_Node]); end; destructor TdomDocumentType.destroy; begin FEntitiesListing.free; FEntitiesList.free; FNotationsListing.free; FNotationsList.free; inherited destroy; end; function TdomDocumentType.validate2: boolean; begin result:= true; end; function TdomDocumentType.GetEntities: TdomNamedNodeMap; begin Result:= FEntitiesList; end; function TdomDocumentType.GetInternalSubset: wideString; begin Result:= FInternalSubset; end; function TdomDocumentType.GetName: wideString; begin Result:= NodeName; end; function TdomDocumentType.GetNotations: TdomNamedNodeMap; begin Result:= FNotationsList; end; function TdomDocumentType.GetPublicId: wideString; begin Result:= FPublicId; end; function TdomDocumentType.GetSystemId: wideString; begin Result:= FSystemId; end; procedure TdomDocumentType.SetNodeValue(const value: wideString); begin end; //++++++++++++++++++++++++++ TdomNotation ++++++++++++++++++++++++++++++ constructor TdomNotation.create(const aOwner: TdomDocument; const name, pubId, sysId: wideString); begin if not IsXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); if not isXmlSystemChars(sysId) then raise EInvalid_Character_Err.create('Invalid character error.'); if not isXmlPubidChars(publicId) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FNodeName:= name; FNodeValue:= ''; FPublicId:= pubId; FSystemId:= sysId; FNodeType:= ntNotation_Node; FAllowedChildTypes:= []; end; procedure TdomNotation.SetNodeValue(const value: wideString); begin // Do nothing. end; function TdomNotation.GetPublicId: wideString; begin Result:= FPublicId; end; function TdomNotation.GetSystemId: wideString; begin Result:= FSystemId; end; //+++++++++++++++++++++++++++ TdomEntity +++++++++++++++++++++++++++++++++ constructor TdomEntity.create(const aOwner: TdomDocument; const name, pubId, sysId, notaName: wideString); begin if not IsXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); if not isXmlSystemChars(sysId) then raise EInvalid_Character_Err.create('Invalid character error.'); if not isXmlPubidChars(pubId) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FNodeName:= name; FNotationName:= notaName; FNodeType:= ntEntity_Node; FPublicId:= pubId; FSystemId:= sysId; FEncoding:= ''; FVersion:= ''; FAllowedChildTypes:= [ntElement_Node, ntProcessing_Instruction_Node, ntComment_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node, ntDocument_Fragment_Node]; end; function TdomEntity.GetNotationName: wideString; begin Result:= FNotationName; end; procedure TdomEntity.SetNodeValue(const value: wideString); begin // Do nothing end; function TdomEntity.insertBefore(const newChild, refChild: TdomNode): TdomNode; begin if (publicId <> '') or (systemId <> '') then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); Result:= inherited insertBefore(newChild,refChild); end; function TdomEntity.replaceChild(const newChild, oldChild: TdomNode): TdomNode; begin if (publicId <> '') or (systemId <> '') then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); Result:= inherited replaceChild(newChild,oldChild); end; function TdomEntity.appendChild(const newChild: TdomNode): TdomNode; begin if (publicId <> '') or (systemId <> '') then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); Result:= inherited appendChild(newChild); end; //++++++++++++++++++++++++ TdomEntityReference +++++++++++++++++++++++++ constructor TdomEntityReference.create(const aOwner: TdomDocument; const name: wideString); begin if not IsXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FNodeName:= name; FNodeValue:= ''; FNodeType:= ntEntity_Reference_Node; FAllowedChildTypes:= [ntElement_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node, ntProcessing_Instruction_Node, ntComment_Node, ntDocument_Fragment_Node]; end; function TdomEntityReference.getCorrespondingCMEntity: TdomCMEntity; var cm: TdomCMObject; begin cm:= ownerDocument.contentModel; if assigned(cm) then result:= cm.Entities.getNamedItem(NodeName) else result:= nil; end; function TdomEntityReference.getRefersToPredefinedEntity: boolean; begin if (nodeName = 'lt') or (nodeName = 'gt') or (nodeName = 'amp') or (nodeName = 'apos') or (nodeName = 'quot') then result:= true else result:= false; end; function TdomEntityReference.expand: boolean; // Resolves the replacement text of the entity reference by the value of // its correspondingCMEntity or by a default entity respectivly. // Returns 'true' if successful, otherwise 'false'. var S: wideString; cmEnt: TdomCMEntity; parser: TXmlToDomParser; begin result:= true; parser:= TXmlToDomParser.create(nil); try parser.DOMImpl:= ownerDocument.domImplementation; clear; cmEnt:= correspondingCMEntity; if assigned(cmEnt) then begin try S:= cmEnt.replacementText; if S <> '' then parser.docWideStringToDom(S,'','',self); // xxx setting the readonly property is missing here! except result:= false; end; end else begin if (nodeName='lt') then begin appendChild(ownerDocument.CreateTextNode(#60)) end else if (nodeName='gt') then begin appendChild(ownerDocument.CreateTextNode(#62)) end else if (nodeName='amp') then begin appendChild(ownerDocument.CreateTextNode(#38)) end else if (nodeName='apos') then begin appendChild(ownerDocument.CreateTextNode(#39)) end else if (nodeName='quot') then begin appendChild(ownerDocument.CreateTextNode(#34)) end else result:= false; end; {if assigned(cmEnt) ...} // xxx setting the readonly property is missing here! finally parser.free; end; end; function TdomEntityReference.validate2: boolean; var ent: TdomCMEntity; i: integer; begin result:= true; if not refersToPredefinedEntity then begin // VC: Entity declared (XML 1.0, § 4.1) ent:= getCorrespondingCMEntity; if not assigned(ent) then begin result:= false; sendErrorNotification(ET_ENTITY_DECL_NOT_FOUND,self); exit; end; if ent.isParsedEntity then begin if not ent.resolve then begin result:= false; sendErrorNotification(ET_UNRESOLVABLE_ENTITY_REFERENCE,self); exit; end; // WFC: Parsed Entity (XML 1.0, § 4.1) if ent.refersToUnparsedEntity(true) then begin result:= false; sendErrorNotification(ET_REFERENCE_TO_UNPARSED_ENTITY,self); end; // WFC: No Recursion (XML 1.0, § 4.1) if ent.RefersToItself(true) then begin result:= false; sendErrorNotification(ET_RECURSIVE_REFERENCE,self); end; // WFC: Well-Formed Parsed Entities (XML 1.0, § 4.3.2) if ent.isUnusable then begin result:= false; sendErrorNotification(ET_NO_PROPER_MARKUP_REFERENCED,self); end; {if ...} end; end; {if not refersToPredefinedEntity ...} // validate child nodes: for i:= 0 to pred(childnodes.length) do if not childnodes.item(i).validate2 then result:= false; end; procedure TdomEntityReference.SetNodeValue(const value: wideString); begin // Do nothing. end; function TdomEntityReference.CloneNode(const deep: boolean): TdomNode; begin result:= inherited cloneNode(deep); makeChildrenReadonly; end; function TdomEntityReference.resolveEntityReferences(const opt: TdomEntityResolveOption): boolean; begin result:= true; end; //++++++++++++++++++++++++ TdomDocumentFragment +++++++++++++++++++++++++++ constructor TdomDocumentFragment.create(const aOwner: TdomDocument); begin inherited create(aOwner); FNodeName:= '#document-fragment'; FNodeValue:= ''; FNodeType:= ntDocument_Fragment_Node; FAllowedChildTypes:= [ntElement_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node, ntProcessing_Instruction_Node, ntComment_Node, ntDocument_Type_Node, // xxx not DOM conformant. Delete? ntDocument_Fragment_Node]; end; procedure TdomDocumentFragment.SetNodeValue(const value: wideString); begin end; //+++++++++++++++++++++++++ TdomXPathNamespace ++++++++++++++++++++++++++++ constructor TdomXPathNamespace.create(const aOwnerElement: TdomElement; const anamespaceUri, aprefix: wideString); begin if not ( IsXmlPrefix(aprefix) or (aprefix = '') ) then raise EInvalid_Character_Err.create('Invalid character error.'); if ( (aprefix = 'xmlns') and not (anamespaceURI = 'http://www.w3.org/2000/xmlns/') ) then raise ENamespace_Err.create('Namespace error.'); if (anamespaceURI = '') and (aprefix <> '') then raise ENamespace_Err.create('Namespace error.'); if (aprefix = 'xml') and (anamespaceURI <> 'http://www.w3.org/XML/1998/namespace') then raise ENamespace_Err.create('Namespace error.'); FOwnerElement:= aOwnerElement; FIsReadonly:= true; FNodeType:= ntXPath_Namespace_Node; FNodeName:= aprefix; FPrefix:= aprefix; FNamespaceURI:= anamespaceUri; end; function TdomXPathNamespace.getDocument: TdomDocument; begin result:= FOwnerElement.ownerDocument; end; function TdomXPathNamespace.getOwnerElement: TdomElement; begin result:= FOwnerElement; end; //++++++++++++++++++++++++++++ TdomDocument +++++++++++++++++++++++++++++++ constructor TdomDocument.create(const aOwner: TDomImplementation); begin inherited create(self); FDomImpl:= aOwner; FNodeName:= '#document'; FNodeValue:= ''; FNodeType:= ntDocument_Node; FEncoding:= ''; FStandalone:= ''; FSystemId:= ''; FVersion:= ''; FBaseUri:= ''; FModified:= false; FCMInternal:= nil; FDefaultView:= nil; FCreatedNodes:= TList.create; FCreatedNodeIterators:= TList.create; FCreatedTreeWalkers:= TList.create; FCreatedElementsNodeLists:= TList.create; FCreatedElementsNodeListNSs:= TList.create; FCreatedExpressions:= TList.create; FCreatedNSResolvers:= TList.create; FIDs:= TdomWideStringList.create; FIDs.Sorted:= true; FIDs.Duplicates:= dupError; FAllowedChildTypes:= [ntElement_Node, ntProcessing_Instruction_Node, ntComment_Node, ntDocument_Type_Node, ntDocument_Fragment_Node]; end; destructor TdomDocument.destroy; begin clear; FCreatedNodes.Free; FCreatedNodeIterators.Free; FCreatedTreeWalkers.Free; FCreatedElementsNodeLists.free; FCreatedElementsNodeListNSs.free; FCreatedExpressions.free; FCreatedNSResolvers.free; FIDs.free; inherited destroy; end; procedure TdomDocument.SetNodeValue(const value: wideString); begin // Do nothing. end; procedure TdomDocument.FindNewReferenceNodes(const NodeToRemove: TdomNode); var i: integer; refNode, refRoot: TdomNode; begin for i:= 0 to FCreatedNodeIterators.count-1 do begin refNode:= TdomNodeIterator(FCreatedNodeIterators[i]).FReferenceNode; if (refNode = NodeToRemove) or refNode.IsAncestor(NodeToRemove) then begin refRoot:= TdomNodeIterator(FCreatedNodeIterators[i]).root; if NodeToRemove.IsAncestor(refRoot) then TdomNodeIterator(FCreatedNodeIterators[i]).FindNewReferenceNode(NodeToRemove); end; end; end; procedure TdomDocument.clear; var i : integer; begin FNodeListing.clear; for i := 0 to FCreatedNodes.Count - 1 do TdomNode(FCreatedNodes[i]).free; FCreatedNodes.Clear; for i := 0 to FCreatedNodeIterators.Count - 1 do TdomNodeIterator(FCreatedNodeIterators[i]).free; FCreatedNodeIterators.Clear; for i := 0 to FCreatedTreeWalkers.Count - 1 do TdomTreeWalker(FCreatedTreeWalkers[i]).Free; FCreatedTreeWalkers.Clear; for i := 0 to FCreatedElementsNodeLists.Count - 1 do TdomElementsNodeList(FCreatedElementsNodeLists[i]).free; FCreatedElementsNodeLists.Clear; for i := 0 to FCreatedElementsNodeListNSs.Count - 1 do TdomElementsNodeListNS(FCreatedElementsNodeListNSs[i]).free; FCreatedElementsNodeListNSs.Clear; for i := 0 to FCreatedNSResolvers.Count - 1 do TdomXPathNSResolver(FCreatedNSResolvers[i]).Free; FCreatedNSResolvers.Clear; for i:= 0 to FCreatedExpressions.count-1 do TdomXPathExpression(FCreatedExpressions[i]).free; FCreatedExpressions.Clear; end; procedure TdomDocument.ClearInvalidNodeIterators; var i: integer; begin for i:= 0 to FCreatedNodeIterators.count-1 do if TdomNodeIterator(FCreatedNodeIterators[i]).FInvalid then begin TdomNodeIterator(FCreatedNodeIterators[i]).free; FCreatedNodeIterators[i]:= nil; end; FCreatedNodeIterators.pack; FCreatedNodeIterators.Capacity:= FCreatedNodeIterators.Count; end; function TdomDocument.createEntity(const name, pubId, sysId, notaName: wideString): TdomEntity; begin result:= TdomEntity.create(self,name,pubId,sysId,notaName); FCreatedNodes.add(result); end; function TdomDocument.createNotation(const name, pubId, sysId: wideString): TdomNotation; begin result:= TdomNotation.create(self,name,pubId,sysId); FCreatedNodes.add(result); end; function TdomDocument.importNode(const importedNode: TdomNode; const deep: boolean): TdomNode; var cm: TdomCMObject; i: integer; newChild: TdomNode; attri: TdomCMAttribute; newAttr, oldAttr, textAttr: TdomAttr; nsAware: boolean; begin if not assigned(importedNode) then raise ENot_Supported_Err.create('Not supported error.'); case importedNode.NodeType of ntAttribute_Node: begin with importedNode do if isNamespaceNode then result:= createAttributeNS(namespaceURI,nodeName) else result:= createAttribute(nodeName); Result.FNodeValue:= FNodeValue; // duplicate the text of the attribute node: for i:= 0 to pred(importedNode.ChildNodes.Length) do begin newChild:= importNode(importedNode.ChildNodes.Item(i),true); Result.appendChild(newChild); end; end; ntCDATA_Section_Node: Result:= createCDATASection((importedNode as TdomCDATASection).Data); ntComment_Node: Result:= createComment((importedNode as TdomComment).Data); ntDocument_Fragment_Node: begin Result:= createDocumentFragment; if deep then for i:= 0 to pred(importedNode.ChildNodes.Length) do begin newChild:= importNode(importedNode.ChildNodes.Item(i),true); Result.appendChild(newChild); end; end; ntElement_Node: begin with importedNode do if isNamespaceNode then result:= createElementNS(namespaceURI,nodeName) else result:= createElement(nodeName); nsAware:= importedNode.attributes.namespaceAware; Result.attributes.namespaceAware:= nsAware; // Duplicating specified attributes: if nsAware then begin for i:= 0 to importedNode.attributes.Length-1 do begin oldAttr:= TdomAttr(importedNode.attributes.Item(i)); if oldAttr.specified then begin newChild:= importNode(oldAttr,true); (result as TdomElement).setAttributeNodeNS((newChild as TdomAttr)); end; end; {for i:= 0 to ...} end else begin for i:= 0 to importedNode.attributes.Length-1 do begin oldAttr:= TdomAttr(importedNode.attributes.Item(i)); if oldAttr.specified then begin newChild:= importNode(oldAttr,true); (result as TdomElement).setAttributeNode((newChild as TdomAttr)); end; end; {for i:= 0 to ...} end; {if ... else ...} // Adding default attributes: cm:= OwnerDocument.contentModel; if assigned(cm) then begin with cm.attributes do begin for i:= 0 to pred(length) do begin attri:= item(i); if attri.elementName = (result as TdomElement).nodeName then begin if (attri.defaultDeclaration <> '#REQUIRED') and (attri.defaultDeclaration <> '#IMPLIED') then begin textAttr:= (result as TdomElement).getAttributeNode(attri.attributeName); if not assigned(textAttr) then begin newAttr:= OwnerDocument.CreateAttribute(attri.AttributeName); newAttr.value:= attri.NodeValue; newAttr.FSpecified:= false; (result as TdomElement).SetAttributeNode(newAttr); end; {if not ...} end; {if ...} end; {if ...} end; {with ...} end; {if assigned(cm) ...} end; {for i:= 0 to ...} // Duplicating child nodes: if deep then for i:= 0 to pred(importedNode.ChildNodes.Length) do begin newChild:= importNode(importedNode.ChildNodes.Item(i),true); Result.appendChild(newChild); end; end; ntEntity_Node: with (importedNode as TdomEntity) do begin result:= createEntity(nodeName,publicId,systemId,notationName); (result as TdomEntity).encoding:= encoding; (result as TdomEntity).version:= version; if deep then for i:= 0 to pred(childNodes.length) do begin newChild:= importNode(childNodes.Item(i),true); result.appendChild(newChild); end; end; ntEntity_Reference_Node: begin Result:= createEntityReference(importedNode.NodeName); (result as TdomEntityReference).expand; end; ntNotation_Node: with (importedNode as TdomEntity) do begin result:= createNotation(nodeName,publicId,systemId); end; ntProcessing_Instruction_Node: Result:= createProcessingInstruction((importedNode as TdomProcessingInstruction).target, (importedNode as TdomProcessingInstruction).data); ntText_Node: Result:= createTextNode((importedNode as TdomText).Data); else raise ENot_Supported_Err.create('Not supported error.'); end; end; procedure TdomDocument.doAttrModified(originalTarget: TdomNode; attrChange: TdomAttrChange; prevValue, newValue: wideString; relatedAttr: TdomAttr); begin FModified:= true; try inherited; finally if assigned(FParentNode) then domImplementation.doAttrModified(self,originalTarget,attrChange,prevValue,newValue,relatedAttr); end; end; procedure TdomDocument.doCharacterDataModified(originalTarget: TdomNode; prevValue, newValue: wideString); begin FModified:= true; try inherited; finally if assigned(FParentNode) then domImplementation.doCharacterDataModified(self,originalTarget,prevValue,newValue); end; end; procedure TdomDocument.doNodeInserted(originalTarget: TdomNode); begin FModified:= true; try inherited; finally if assigned(FParentNode) then domImplementation.doNodeInserted(self,originalTarget); end; end; procedure TdomDocument.doNodeRemoved(originalTarget: TdomNode); begin FModified:= true; try inherited; finally if assigned(FParentNode) then domImplementation.doNodeRemoved(self,originalTarget); end; end; function TdomDocument.getBaseUri: wideString; begin result:= FBaseUri; end; procedure TdomDocument.InitDoc(const tagName: wideString); begin if not IsXmlName(tagName) then raise EInvalid_Character_Err.create('Invalid character error.'); if assigned (DocumentElement) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); appendChild(CreateElement(tagName)); end; procedure TdomDocument.InitDocNS(const anamespaceURI, aqualifiedName: wideString); var prfx, alocalName: wideString; begin if not IsXmlName(aqualifiedName) then raise EInvalid_Character_Err.create('Invalid character error.'); if not xmlExtractPrefixAndLocalName(aqualifiedName,prfx,alocalName) then begin if not IsXmlName(aqualifiedName) then raise EInvalid_Character_Err.create('Invalid character error.') else raise ENamespace_Err.create('Namespace error.'); end; if ( ((prfx = 'xmlns') or (aqualifiedName = 'xmlns')) and not (anamespaceURI ='http://www.w3.org/2000/xmlns/') ) then raise ENamespace_Err.create('Namespace error.'); if (anamespaceURI = '') and (prfx <> '') then raise ENamespace_Err.create('Namespace error.'); if (prfx = 'xml') and (anamespaceURI <> 'http://www.w3.org/XML/1998/namespace') then raise ENamespace_Err.create('Namespace error.'); if assigned (DocumentElement) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); appendChild(CreateElementNS(anamespaceURI,aqualifiedName)); end; function TdomDocument.removeContentModel: TdomCMObject; begin if assigned(FCMInternal) then FCMInternal.FAssociatedDocument:= nil; result:= FCMInternal; FCMInternal:= nil; end; procedure TdomDocument.setBaseUri(const value: wideString); var uri: string; begin try uri:= UTF16To7BitASCIIStr(value); except raise ESyntax_Err.create('Syntax error.'); end; if not isUriAbsoluteURIStr(uri) then raise ESyntax_Err.create('Syntax error.'); FBaseUri:= value; end; function TdomDocument.setContentModel(const arg: TdomCMObject): TdomCMObject; begin result:= removeContentModel; if assigned(arg) then if assigned(arg.associatedDocument) then raise EInuse_Content_Model_Err.create('Inuse content model error.'); FCMInternal:= arg; arg.FAssociatedDocument:= self; end; function TdomDocument.GetDoctype: TdomDocumentType; var Child: TdomNode; begin Result:= nil; Child:= getFirstChild; while assigned(Child) do begin if Child.NodeType = ntDocument_Type_Node then begin Result:= (Child as TdomDocumentType); break; end; Child:= Child.NextSibling; end; end; function TdomDocument.GetDocumentElement: TdomElement; var Child: TdomNode; begin Result:= nil; Child:= getFirstChild; while assigned(Child) do begin if Child.NodeType = ntElement_Node then begin Result:= (Child as TdomElement); break; end; Child:= Child.NextSibling; end; end; function TdomDocument.CreateElement(const tagName: wideString): TdomElement; begin Result:= TdomElement.create(self,tagName); FCreatedNodes.add(Result); end; function TdomDocument.CreateElementNS(const anamespaceURI, aqualifiedName: wideString): TdomElement; begin Result:= TdomElement.createNS(self,anamespaceURI,aqualifiedName); FCreatedNodes.add(Result); Result.attributes.namespaceAware:= true; end; function TdomDocument.CreateDocumentFragment: TdomDocumentFragment; begin Result:= TdomDocumentFragment.create(self); FCreatedNodes.add(Result); end; function TdomDocument.CreateTextNode(const Data: wideString): TdomText; begin Result:= TdomText.create(self); Result.Data:= Data; FCreatedNodes.add(Result); end; function TdomDocument.CreateComment(const Data: wideString): TdomComment; begin Result:= TdomComment.create(self); Result.Data:= Data; FCreatedNodes.add(Result); end; function TdomDocument.CreateCDATASection(const Data: wideString): TdomCDATASection; begin Result:= TdomCDATASection.create(self); Result.Data:= Data; FCreatedNodes.add(Result); end; function TdomDocument.CreateProcessingInstruction(const targ, Data : wideString): TdomProcessingInstruction; begin Result:= TdomProcessingInstruction.create(self,targ); Result.Data:= Data; FCreatedNodes.add(Result); end; function TdomDocument.CreateAttribute(const name: wideString): TdomAttr; begin Result:= TdomAttr.create(self,name,true); FCreatedNodes.add(Result); end; function TdomDocument.CreateAttributeNS(const anamespaceURI, aqualifiedName: wideString): TdomAttr; begin Result:= TdomAttr.createNS(self,anamespaceURI,aqualifiedName,true); FCreatedNodes.add(Result); end; function TdomDocument.CreateEntityReference(const name: wideString): TdomEntityReference; begin Result:= TdomEntityReference.create(self,name); FCreatedNodes.add(Result); end; function TdomDocument.createExpression(const expression: wideString; const resolver: TdomXPathNSResolver): TdomXPathExpression; begin result:= TdomXPathExpression.create(self,expression,resolver); FCreatedExpressions.add(result); end; function TdomDocument.CreateDocumentType(const aname, pubId, sysId, IntSubset: wideString): TdomDocumentType; begin Result:= TdomDocumentType.create(self,aname,pubId,sysId,IntSubset); FCreatedNodes.add(Result); end; procedure TdomDocument.freeAllNodes(var node: TdomNode); var index: integer; oldChild: TdomNode; oldAttr: TdomAttr; begin if not assigned(node) then exit; if node.OwnerDocument <> Self then raise EWrong_Document_Err.create('Wrong document error.'); if node = Self then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if assigned(node.ParentNode) then raise EInuse_Node_Err.create('Inuse node error.'); if node.NodeType = ntAttribute_Node then if assigned((node as TdomAttr).OwnerElement) then raise EInuse_Attribute_Err.create('Inuse attribute error.'); // xxx notations ? while node.HasChildNodes do begin node.FirstChild.setIsReadonly(false); oldChild:= node.RemoveChild(node.FirstChild); node.OwnerDocument.FreeAllNodes(oldChild); end; case node.NodeType of ntElement_Node: while node.Attributes.Length > 0 do begin oldAttr:= (node.Attributes.item(0) as TdomAttr); oldAttr.setIsReadonly(false); (node as TdomElement).RemoveAttributeNode(oldAttr); node.OwnerDocument.FreeAllNodes(TdomNode(oldAttr)); end; end; {case ...} index:= FCreatedNodes.IndexOf(node); node.free; FCreatedNodes.Delete(index); node:= nil; end; procedure TdomDocument.freeExpression(var expression: TdomXPathExpression); var index: integer; begin if not assigned(expression) then exit; index:= FCreatedExpressions.IndexOf(expression); if index = -1 then raise EWrong_Document_Err.create('Wrong document error.'); FCreatedExpressions.delete(index); expression.free; expression:= nil; end; procedure TdomDocument.freeNSResolver(var resolver: TdomXPathNSResolver); var index: integer; begin if not assigned(resolver) then exit; index:= FCreatedNSResolvers.IndexOf(resolver); if index = -1 then raise EWrong_Document_Err.create('Wrong document error.'); FCreatedNSResolvers.Delete(index); resolver.free; resolver:= nil; end; procedure TdomDocument.freeTreeWalker(var TreeWalker: TdomTreeWalker); var TreeWalkerIndex: integer; begin if not assigned(TreeWalker) then exit; TreeWalkerIndex:= FCreatedTreeWalkers.IndexOf(TreeWalker); if TreeWalkerIndex = -1 then raise EWrong_Document_Err.create('Wrong document error.'); FCreatedTreeWalkers.Delete(TreeWalkerIndex); TreeWalker.free; TreeWalker:= nil; end; function TdomDocument.GetElementById(const elementId: wideString): TdomElement; begin result:= nil; end; function TdomDocument.GetElementsByTagName(const tagName: wideString): TdomNodeList; var i: integer; begin for i:= 0 to FCreatedElementsNodeLists.Count - 1 do if TdomElementsNodeList(FCreatedElementsNodeLists[i]).FQueryName = tagName then begin Result:= TdomElementsNodeList(FCreatedElementsNodeLists[i]); exit; end; Result:= TdomElementsNodeList.create(tagName,self); FCreatedElementsNodeLists.add(Result); end; function TdomDocument.GetElementsByTagNameNS(const anamespaceURI, alocalName: wideString): TdomNodeList; var i: integer; nl: TdomElementsNodeListNS; begin for i:= 0 to FCreatedElementsNodeListNSs.Count - 1 do begin nl:= TdomElementsNodeListNS(FCreatedElementsNodeListNSs[i]); if (nl.FQueryNamespaceURI = anamespaceURI) and (nl.FQueryLocalName = alocalName) then begin Result:= nl; exit; end; end; Result:= TdomElementsNodeListNS.create(anamespaceURI,alocalName,self); FCreatedElementsNodeListNSs.add(Result); end; function TdomDocument.insertBefore(const newChild, refChild: TdomNode): TdomNode; begin if not assigned(newChild) then raise ENot_Supported_Err.create('Not supported error.'); case newChild.NodeType of ntElement_Node: begin if assigned(DocType) then begin if DocType.NodeName <> newChild.NodeName then raise EInvalid_Character_Err.create('Invalid character error.'); if ChildNodes.IndexOf(DocType) >= ChildNodes.IndexOf(refChild) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); end; if assigned(DocumentElement) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); Result:= inherited insertBefore(newChild,refChild); end; ntDocument_Type_Node: begin if assigned(DocumentElement) then begin if DocumentElement.NodeName <> newChild.NodeName then raise EInvalid_Character_Err.create('Invalid character error.'); if ChildNodes.IndexOf(DocumentElement) < ChildNodes.IndexOf(refChild) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); end; if assigned(DocType) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); Result:= inherited insertBefore(newChild,refChild); end; ntProcessing_Instruction_Node,ntComment_Node,ntDocument_Fragment_Node: Result:= inherited insertBefore(newChild,refChild); else raise EHierarchy_Request_Err.create('Hierarchy request error.'); end; end; function TdomDocument.replaceChild(const newChild, oldChild: TdomNode): TdomNode; begin if not ( assigned(newChild) and assigned(oldChild) ) then raise ENot_Supported_Err.create('Not supported error.'); case newChild.NodeType of ntElement_Node: begin if assigned(DocumentElement) and (DocumentElement <> oldChild) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); if assigned(DocType) then if DocType.NodeName <> newChild.NodeName then raise EInvalid_Character_Err.create('Invalid character error.'); Result:= inherited replaceChild(newChild,oldChild); end; ntDocument_Type_Node: begin if assigned(DocType) and (DocType <> oldChild) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); if assigned(DocumentElement) then if DocumentElement.NodeName <> newChild.NodeName then raise EInvalid_Character_Err.create('Invalid character error.'); Result:= inherited replaceChild(newChild,oldChild); end; ntProcessing_Instruction_Node,ntComment_Node, ntDocument_Fragment_Node: Result:= inherited replaceChild(newChild,oldChild); else raise EHierarchy_Request_Err.create('Hierarchy request error.'); end; end; function TdomDocument.appendChild(const newChild: TdomNode): TdomNode; begin if not assigned(newChild) then raise ENot_Supported_Err.create('Not supported error.'); case newChild.NodeType of ntElement_Node: begin if assigned(DocumentElement) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); Result:= inherited appendChild(newChild); end; ntDocument_Type_Node: begin if assigned(Doctype) or assigned(DocumentElement) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); Result:= inherited appendChild(newChild); end; ntProcessing_Instruction_Node,ntComment_Node, ntDocument_Fragment_Node: Result:= inherited appendChild(newChild); else raise EHierarchy_Request_Err.create('Hierarchy request error.'); end; end; function TdomDocument.CreateNodeIterator(const root: TdomNode; whatToShow: TdomWhatToShow; nodeFilter: TdomNodeFilter; entityReferenceExpansion: boolean): TdomNodeIterator; begin Result:= TdomNodeIterator.create(root,whatToShow,nodeFilter,entityReferenceExpansion); FCreatedNodeIterators.add(Result); end; function TdomDocument.CreateTreeWalker(const root: TdomNode; whatToShow: TdomWhatToShow; nodeFilter: TdomNodeFilter; entityReferenceExpansion: boolean): TdomTreeWalker; begin; Result:= TdomTreeWalker.create(root,whatToShow,nodeFilter,entityReferenceExpansion); FCreatedTreeWalkers.add(Result); end; function TdomDocument.CreateNSResolver(const nodeResolver: TdomNode): TdomXPathNSResolver; begin; Result:= TdomXPathNSResolver.create(nodeResolver); FCreatedNSResolvers.add(Result); end; function TdomDocument.validate(const opt: TdomEntityResolveOption): boolean; var i: integer; ok: boolean; begin result:= true; if not assigned(documentElement) then raise EValidation_Err.create('Validation Error: Root not found.'); if assigned(docType) then begin if assigned(contentModel) then if not contentModel.validate then result:= false; end; ok:= resolveEntityReferences(opt); if not ok then begin result:= false; sendErrorNotification(ET_UNRESOLVABLE_ENTITY_REFERENCE,self); end; // VC: Root Element Type (XML 1.0, § 2.8) if assigned(docType) then begin if docType.name <> documentElement.NodeName then begin result:= false; sendErrorNotification(ET_WRONG_ROOT_ELEMENT_TYPE,self); end; end; IDs.clear; for i:= 0 to pred(childnodes.length) do begin if not childnodes.item(i).validate2 then result:= false; end; if not result then IDs.clear else begin // VC: IDREF (XML 1.0, § 3.3.1) // Second parse only for IDREF and IDREFS: if not validateIDREFs then result:= false; end; end; function TdomDocument.validateIDREFS: boolean; begin result:= documentElement.validateIDREFS; end; //+++++++++++++++++++++++++ TdomASObjectList +++++++++++++++++++++++++++++ constructor TdomASObjectList.create; begin inherited create; FNodeList:= TList.create; end; destructor TdomASObjectList.destroy; begin FNodeList.free; inherited; end; procedure TdomASObjectList.clear; begin FNodeList.clear; end; function TdomASObjectList.appendASNode(const newNode: TdomASObject): TdomASObject; begin FNodeList.Add(newNode); result:= newNode; end; procedure TdomASObjectList.Delete(const index: integer); begin FNodeList.Delete(index); end; function TdomASObjectList.indexOf(const node: TdomASObject): integer; begin result:= FNodeList.indexOf(node); end; function TdomASObjectList.getLength: integer; begin Result:= FNodeList.count; end; function TdomASObjectList.insertBefore(const newNode, refNode: TdomASObject): TdomASObject; begin Result:= newNode; with FNodeList do if assigned(refNode) then insert(indexOf(refNode),newNode) else add(newNode); end; function TdomASObjectList.removeASNode(const oldNode: TdomASObject): TdomASObject; begin Result:= oldNode; FNodeList.Remove(oldNode); end; function TdomASObjectList.item(const index: integer): TdomASObject; begin if (index < 0) or (index + 1 > FNodeList.count) then Result:= nil else Result:= TdomASObject(FNodeList.Items[index]); end; //+++++++++++++++++++++++++ TdomASNamedObjectMap +++++++++++++++++++++++++ constructor TdomASNamedObjectMap.create(const aOwner: TdomASModel; const namespaceAware: boolean); begin inherited create; FOwnerAsModel:= aOwner; FNamespaceAware:= namespaceAware; FNodeList:= TList.create; FNamespaceAware:= false; end; destructor TdomASNamedObjectMap.destroy; begin FNodeList.free; inherited; end; function TdomASNamedObjectMap.getLength: integer; begin Result:= FNodeList.count; end; function TdomASNamedObjectMap.GetNamedItem(const name: wideString): TdomASObject; var i: integer; begin if FNamespaceAware then raise ENamespace_Err.create('Namespace error.'); result:= nil; for i:= 0 to pred(FNodeList.count) do if (TdomASObject(FNodeList[i]).ASObjectName = name) then begin Result:= TdomASObject(FNodeList[i]); break; end; end; function TdomASNamedObjectMap.GetNamedItemNS(const namespaceURI, localName: wideString): TdomASObject; var i: integer; begin if not FNamespaceAware then raise ENamespace_Err.create('Namespace error.'); result:= nil; for i:= 0 to pred(FNodeList.count) do if (TdomASObject(FNodeList[i]).namespaceURI = namespaceURI) and (TdomASObject(FNodeList[i]).localName = localName) then begin Result:= TdomASObject(FNodeList[i]); break; end; end; function TdomASNamedObjectMap.item(const index: integer): TdomASObject; begin if (index < 0) or (index + 1 > FNodeList.count) then Result:= nil else Result:= TdomASObject(FNodeList.Items[index]); end; function TdomASNamedObjectMap.RemoveNamedItem(const name: wideString): TdomASObject; begin if FNamespaceAware then raise ENamespace_Err.create('Namespace error.'); Result:= getNamedItem(name); if not assigned(Result) then raise ENot_Found_Err.create('Not found error.'); FNodeList.Remove(Result); Result.FInuse:= false; end; function TdomASNamedObjectMap.RemoveNamedItemNS(const namespaceURI, localName: wideString): TdomASObject; begin if not FNamespaceAware then raise ENamespace_Err.create('Namespace error.'); Result:= getNamedItemNS(namespaceURI,localName); if not assigned(Result) then raise ENot_Found_Err.create('Node not found error.'); FNodeList.Remove(Result); Result.FInuse:= false; end; function TdomASNamedObjectMap.SetNamedItem(const arg: TdomASObject): TdomASObject; begin if FNamespaceAware then raise ENamespace_Err.create('Namespace error.'); if FOwnerAsModel <> arg.OwnerASModel then raise EWrong_ASModel_Err.create('Wrong abstract schema model error.'); if arg.FInuse then raise EInuse_Node_Err.create('Inuse node error.'); if assigned(GetNamedItem(arg.ASObjectName)) then Result:= RemoveNamedItem(arg.ASObjectName) else Result:= nil; FNodeList.Add(arg); Result.FInuse:= true; end; function TdomASNamedObjectMap.SetNamedItemNS(const arg: TdomASObject): TdomASObject; begin if not FNamespaceAware then raise ENamespace_Err.create('Namespace error.'); if FOwnerAsModel <> arg.OwnerASModel then raise EWrong_ASModel_Err.create('Wrong abstract schema model error.'); if arg.FInuse then raise EInuse_Node_Err.create('Inuse node error.'); if assigned(GetNamedItemNS(arg.namespaceURI,arg.localName)) then Result:= RemoveNamedItemNS(arg.namespaceURI,arg.localName) else Result:= nil; FNodeList.Add(arg); Result.FInuse:= true; end; //+++++++++++++++++++++++++++ TdomASObject +++++++++++++++++++++++++++++++ constructor TdomASObject.create(const aOwner: TdomASModel); begin inherited create; FOwnerAsModel:= aOwner; FInuse:= false; end; procedure TdomASObject.setPrefix(const value: wideString); begin if not IsXmlName(value) then raise EInvalid_Character_Err.create('Invalid character error.'); if not IsXmlPrefix(value) then raise ENamespace_Err.create('Namespace error.'); if namespaceURI = '' then raise ENamespace_Err.create('Namespace error.'); if (value = 'xml') and (namespaceURI <> 'http://www.w3.org/XML/1998/namespace') then raise ENamespace_Err.create('Namespace error.'); if FASObjectType = AS_ATTRIBUTE_DECLARATION then begin if (value = 'xmlns') and not (namespaceURI ='http://www.w3.org/2000/xmlns/') then raise ENamespace_Err.create('Namespace error.'); if FASObjectName = 'xmlns' then raise ENamespace_Err.create('Namespace error.'); end; FPrefix:= value; FASObjectName:= concat(value,':',localName); end; //+++++++++++++++++++++++++++ TdomASContentModel +++++++++++++++++++++++++++ constructor TdomASContentModel.create(const aOwner: TdomASModel); begin inherited create(aOwner); FASObjectType:= AS_CONTENTMODEL; FSubModels:= TdomASObjectList.create; FListOperator:= AS_CHOICE; FMaxOccurs:= AS_UNBOUND; FMinOccurs:= 0; end; destructor TdomASContentModel.destroy; begin FSubModels.free; inherited; end; function TdomASContentModel.appendASNode(const newNode: TdomASObject): TdomASObject; begin with newNode do begin if FASObjectType = AS_CONTENTMODEL then begin if FInuse then raise EInuse_Node_Err.create('Inuse node error.'); FInuse:= true; end; end; result:= FSubModels.appendASNode(newNode); end; function TdomASContentModel.insertBefore(const newNode, refNode: TdomASObject): TdomASObject; begin with newNode do begin if FASObjectType = AS_CONTENTMODEL then begin if FInuse then raise EInuse_Node_Err.create('Inuse node error.'); FInuse:= true; end; end; result:= FSubModels.insertBefore(newNode,refNode); end; function TdomASContentModel.removeASNode(const oldNode: TdomASObject): TdomASObject; begin if FSubModels.indexof(oldNode) = -1 then raise ENot_Found_Err.create('Node not found error.'); with oldNode do if FASObjectType = AS_CONTENTMODEL then FInuse:= false; result:= FSubModels.removeASNode(oldNode); end; //++++++++++++++++++++++ TdomASAttributeDeclaration ++++++++++++++++++++++ constructor TdomASAttributeDeclaration.create(const aOwner: TdomASModel; const name: wideString); begin if not IsXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FASObjectName:= name; FASObjectType:= AS_ATTRIBUTE_DECLARATION; FAttrType:= AS_STRING_DATATYPE; FAttrValue:= ''; FConstraintType:= AS_NO_VALUE_CONSTRAINT; FEnumAttr:= TdomWideStringList.create; end; constructor TdomASAttributeDeclaration.createNS(const aOwner: TdomASModel; const anamespaceURI, qualifiedName: wideString); var locName,prfx: wideString; begin if not xmlExtractPrefixAndLocalName(qualifiedName,prfx,locName) then begin if not IsXmlName(qualifiedName) then raise EInvalid_Character_Err.create('Invalid character error.') else raise ENamespace_Err.create('Namespace error.'); end; if ( ((prfx = 'xmlns') or (qualifiedName = 'xmlns')) and not (anamespaceURI ='http://www.w3.org/2000/xmlns/') ) then raise ENamespace_Err.create('Namespace error.'); if (anamespaceURI = '') and (prfx <> '') then raise ENamespace_Err.create('Namespace error.'); if (prfx = 'xml') and (anamespaceURI <> 'http://www.w3.org/XML/1998/namespace') then raise ENamespace_Err.create('Namespace error.'); create(aOwner,qualifiedName); FNamespaceURI:= anamespaceURI; FPrefix:= prfx; FLocalName:= locName; end; destructor TdomASAttributeDeclaration.destroy; begin FEnumAttr.free; inherited; end; function TdomASAttributeDeclaration.getIsNamespaceAware: boolean; begin result:= FOwnerAsModel.isNamespaceAware; end; //++++++++++++++++++++++++ TdomASEntityDeclaration +++++++++++++++++++++++ constructor TdomASEntityDeclaration.create(const aOwner: TdomASModel; const name: wideString); begin if not IsXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FASObjectType:= AS_ENTITY_DECLARATION; FEntityType:= AS_INTERNAL_ENTITY; FEntityValue:= ''; FNotationName:= ''; FPublicId:= ''; FSystemId:= ''; end; //+++++++++++++++++++++++ TdomASNotationDeclaration ++++++++++++++++++++++ constructor TdomASNotationDeclaration.create(const aOwner: TdomASModel; const name, pubId, sysId: wideString); begin if not IsXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FASObjectType:= AS_NOTATION_DECLARATION; FNotationName:= name; FPublicId:= pubId; FSystemId:= sysId; end; constructor TdomASNotationDeclaration.createNS(const aOwner: TdomASModel; const anamespaceURI, qualifiedName, pubId, sysId: wideString); var locName,prfx: wideString; begin if not xmlExtractPrefixAndLocalName(qualifiedName,prfx,locName) then begin if not IsXmlName(qualifiedName) then raise EInvalid_Character_Err.create('Invalid character error.') else raise ENamespace_Err.create('Namespace error.'); end; if (anamespaceURI = '') and (prfx <> '') then raise ENamespace_Err.create('Namespace error.'); if (prfx = 'xml') and (anamespaceURI <> 'http://www.w3.org/XML/1998/namespace') then raise ENamespace_Err.create('Namespace error.'); create(aOwner,qualifiedName,pubId,sysId); FNamespaceURI:= anamespaceURI; FPrefix:= prfx; FLocalName:= locName; end; //+++++++++++++++++++++++ TdomASElementDeclaration +++++++++++++++++++++++ constructor TdomASElementDeclaration.create(const aOwner: TdomASModel; const name: wideString); begin if not IsXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FASObjectType:= AS_ELEMENT_DECLARATION; FASObjectName:= name; FAttributeDeclarations:= TdomASNamedObjectMap.create(aOwner,aOwner.FNamespaceAware); FContentModel:= aOwner.createASContentModel; FContentModel.FInuse:= true; FContentType:= AS_MIXED; FElementType:= AS_STRING_DATATYPE; FIsPCDataOnly:= false; FStrictMixedContent:= false; end; constructor TdomASElementDeclaration.createNS(const aOwner: TdomASModel; const anamespaceURI, qualifiedName: wideString); var locName,prfx: wideString; begin if not xmlExtractPrefixAndLocalName(qualifiedName,prfx,locName) then begin if not IsXmlName(qualifiedName) then raise EInvalid_Character_Err.create('Invalid character error.') else raise ENamespace_Err.create('Namespace error.'); end; if (anamespaceURI = '') and (prfx <> '') then raise ENamespace_Err.create('Namespace error.'); if (prfx = 'xml') and (anamespaceURI <> 'http://www.w3.org/XML/1998/namespace') then raise ENamespace_Err.create('Namespace error.'); create(aOwner,qualifiedName); FNamespaceURI:= anamespaceURI; FPrefix:= prfx; FLocalName:= locName; end; destructor TdomASElementDeclaration.destroy; begin FAttributeDeclarations.free; inherited; end; function TdomASElementDeclaration.getIsNamespaceAware: boolean; begin result:= FOwnerAsModel.isNamespaceAware; end; function TdomASElementDeclaration.addASAttributeDecl(const arg: TdomASAttributeDeclaration): boolean; begin if arg.ownerASModel <> ownerASModel then raise EWrong_ASModel_Err.create('Wrong abstract schema model error.'); if arg.FInuse then raise EInuse_Node_Err.create('Inuse node error.'); if isNamespaceAware then begin if assigned(FAttributeDeclarations.getNamedItemNS(arg.namespaceURI,arg.localName)) then begin result:= false; end else begin FAttributeDeclarations.setNamedItemNS(arg); arg.FInuse:= true; result:= true; end; end else begin if assigned(FAttributeDeclarations.getNamedItem(arg.ASObjectName)) then begin result:= false; end else begin FAttributeDeclarations.setNamedItem(arg); arg.FInuse:= true; result:= true; end; end; end; function TdomASElementDeclaration.removeASAttributeDeclaration(const arg: TdomASAttributeDeclaration): TdomASAttributeDeclaration; begin if arg.ownerASModel <> ownerASModel then raise EWrong_ASModel_Err.create('Wrong abstract schema model error.'); if isNamespaceAware then begin if arg = FAttributeDeclarations.getNamedItemNS(arg.namespaceURI,arg.localName) then begin result:= (FAttributeDeclarations.removeNamedItemNS(arg.namespaceURI,arg.localName) as TdomASAttributeDeclaration); result.FInuse:= false; end else result:= nil; end else begin if arg = FAttributeDeclarations.getNamedItem(arg.ASObjectName) then begin result:= (FAttributeDeclarations.removeNamedItem(arg.ASObjectName) as TdomASAttributeDeclaration); result.FInuse:= false; end else result:= nil; end; end; //+++++++++++++++++++++++++++++ TdomASModel +++++++++++++++++++++++++++++ constructor TdomASModel.create(const aOwner: TDomImplementation; const namespaceAware: boolean); begin inherited create(nil); FDomImpl:= aOwner; FNamespaceAware:= namespaceAware; FASObjectType:= AS_MODEL; FAttributeDeclarations:= TdomASNamedObjectMap.create(self,namespaceAware); FContentModelDeclarations:= TdomASNamedObjectMap.create(self,namespaceAware); FElementDeclarations:= TdomASNamedObjectMap.create(self,namespaceAware); FEntityDeclarations:= TdomASNamedObjectMap.create(self,false); FNotationDeclarations:= TdomASNamedObjectMap.create(self,false); FCreatedASNodes:= TdomASObjectList.create; end; destructor TdomASModel.destroy; begin clear; FAttributeDeclarations.free; FContentModelDeclarations.free; FElementDeclarations.free; FEntityDeclarations.free; FNotationDeclarations.free; FCreatedASNodes.free; inherited; end; function TdomASModel.getContainer: boolean; begin result:= (usage in [AS_EXTERNAL_SUBSET,AS_NOT_USED]); // xxx and the container is simply a container of other TdomASModels. end; function TdomASModel.addNamedASElementDeclaration(const arg: TdomASElementDeclaration): boolean; begin if arg.OwnerASModel <> self then raise EWrong_ASModel_Err.create('Wrong abstract schema model error.'); if isNamespaceAware then begin if assigned(FElementDeclarations.getNamedItemNS(arg.namespaceURI,arg.localName)) then begin result:= false; end else begin FElementDeclarations.setNamedItemNS(arg); result:= true; end; end else begin if assigned(FElementDeclarations.getNamedItem(arg.ASObjectName)) then begin result:= false; end else begin FElementDeclarations.setNamedItem(arg); result:= true; end; end; end; function TdomASModel.addNamedASEntityDeclaration(const arg: TdomASEntityDeclaration): boolean; begin if arg.OwnerASModel <> self then raise EWrong_ASModel_Err.create('Wrong abstract schema model error.'); if assigned(FEntityDeclarations.getNamedItem(arg.ASObjectName)) then begin result:= false; end else begin FEntityDeclarations.setNamedItem(arg); result:= true; end; end; function TdomASModel.addNamedASNotationDeclaration(const arg: TdomASNotationDeclaration): boolean; begin if arg.OwnerASModel <> self then raise EWrong_ASModel_Err.create('Wrong abstract schema model error.'); if isNamespaceAware then begin if assigned(FNotationDeclarations.getNamedItemNS(arg.namespaceURI,arg.localName)) then begin result:= false; end else begin FNotationDeclarations.setNamedItemNS(arg); result:= true; end; end else begin if assigned(FNotationDeclarations.getNamedItem(arg.ASObjectName)) then begin result:= false; end else begin FNotationDeclarations.setNamedItem(arg); result:= true; end; end; end; procedure TdomASModel.clear; var i: integer; begin for i := 0 to pred(FCreatedASNodes.length) do TdomASObject(FCreatedASNodes.item(i)).free; FCreatedASNodes.clear; end; function TdomASModel.createASAttributeDeclaration(const anamespaceURI, qualifiedName: wideString): TdomASAttributeDeclaration; begin if isNamespaceAware then result:= TdomASAttributeDeclaration.createNS(self,anamespaceURI,qualifiedName) else result:= TdomASAttributeDeclaration.create(self,qualifiedName); FCreatedASNodes.appendASNode(result); end; function TdomASModel.createASContentModel: TdomASContentModel; begin result:= TdomASContentModel.create(self); FCreatedASNodes.appendASNode(result); end; function TdomASModel.createASElementDeclaration(const anamespaceURI, qualifiedName: wideString): TdomASElementDeclaration; begin if isNamespaceAware then result:= TdomASElementDeclaration.createNS(self,anamespaceURI,qualifiedName) else result:= TdomASElementDeclaration.create(self,qualifiedName); FCreatedASNodes.appendASNode(result); end; function TdomASModel.createASEntityDeclaration(const name: wideString): TdomASEntityDeclaration; begin result:= TdomASEntityDeclaration.create(self,name); FCreatedASNodes.appendASNode(result); end; function TdomASModel.createASNotationDeclaration(const name, pubId, sysId: wideString): TdomASNotationDeclaration; begin result:= TdomASNotationDeclaration.create(self,name,pubId,sysId); FCreatedASNodes.appendASNode(result); end; procedure TdomASModel.freeAllASObjects(var obj: TdomASObject); var index: integer; oldASAttrDecl,oldASChildren: TdomASObject; subModelASObject: TdomASObject; begin if not assigned(obj) then exit; if obj.OwnerASModel <> self then raise EWrong_ASModel_Err.create('Wrong abstract schema model error.'); if obj.FInuse then raise EInuse_Node_Err.create('Inuse obj error.'); case obj.ASObjectType of AS_ELEMENT_DECLARATION: begin with (obj as TdomASElementDeclaration) do begin with attributeDecls do begin for index:= 0 to pred(length) do begin oldASAttrDecl:= item(index); oldASAttrDecl.FInuse:= false; FreeAllASObjects(oldASAttrDecl); end; {for ...} end; {with ...} oldASChildren:= contentModel; oldASChildren.FInuse:= false; FreeAllASObjects(oldASChildren); end; {with ...} end; AS_CONTENTMODEL: begin with (obj as TdomASContentModel).SubModels do begin for index:= 0 to pred(length) do begin subModelASObject:= item(index); if subModelASObject.ASObjectType = AS_CONTENTMODEL then begin subModelASObject.FInuse:= false; FreeAllASObjects(subModelASObject); end; end; {for ...} end {with ...} end; end; {case ...} index:= FCreatedASNodes.IndexOf(obj); obj.free; FCreatedASNodes.Delete(index); obj:= nil; end; function TdomASModel.getNamedASElementDeclaration(const anamespaceURI, name: wideString): TdomASElementDeclaration; begin if isNamespaceAware then result:= (FElementDeclarations.getNamedItemNS(anamespaceURI,name) as TdomASElementDeclaration) else result:= (FElementDeclarations.getNamedItem(name) as TdomASElementDeclaration); end; function TdomASModel.getNamedASEntityDeclaration(const name: wideString): TdomASEntityDeclaration; begin result:= (FEntityDeclarations.getNamedItem(name) as TdomASEntityDeclaration); end; function TdomASModel.getNamedASNotationDeclaration(const anamespaceURI, name: wideString): TdomASNotationDeclaration; begin if isNamespaceAware then result:= (FNotationDeclarations.getNamedItemNS(anamespaceURI,name) as TdomASNotationDeclaration) else result:= (FNotationDeclarations.getNamedItem(name) as TdomASNotationDeclaration); end; function TdomASModel.removeNamedASElementDeclaration(const anamespaceURI, name: wideString): TdomASElementDeclaration; begin if isNamespaceAware then result:= (FElementDeclarations.removeNamedItemNS(anamespaceURI,name) as TdomASElementDeclaration) else result:= (FElementDeclarations.removeNamedItem(name) as TdomASElementDeclaration); end; function TdomASModel.removeNamedASEntityDeclaration(const name: wideString): TdomASEntityDeclaration; begin result:= (FEntityDeclarations.removeNamedItem(name) as TdomASEntityDeclaration); end; function TdomASModel.removeNamedASNotationDeclaration(const anamespaceURI, name: wideString): TdomASNotationDeclaration; begin if isNamespaceAware then result:= (FNotationDeclarations.removeNamedItemNS(anamespaceURI,name) as TdomASNotationDeclaration) else result:= (FNotationDeclarations.removeNamedItem(name) as TdomASNotationDeclaration); end; //+++++++++++++++++++++++++ TdomCMNodeList +++++++++++++++++++++++++++++ constructor TdomCMNodeList.create(const CMNodeList: TList); begin inherited create; FCMNodeList:= CMNodeList; end; function TdomCMNodeList.GetLength: integer; begin Result:= FCMNodeList.count; end; function TdomCMNodeList.IndexOf(const node: TdomCMNode): integer; begin Result:= FCMNodeList.IndexOf(node); end; function TdomCMNodeList.Item(const index: integer): TdomCMNode; begin if (index < 0) or (index + 1 > FCMNodeList.count) then Result:= nil else Result:= TdomCMNode(FCMNodeList.Items[index]); end; //+++++++++++++++++++++++ TdomNamedCMNodeMap +++++++++++++++++++++++++++ constructor TdomNamedCMNodeMap.create(const aOwner, aOwnerNode: TdomCMNode; const nodeList: TList; const allowedNTs: TDomCMNodeTypeSet); begin inherited create(nodeList); FOwner:= aOwner; FOwnerNode:= aOwnerNode; FAllowedNodeTypes:= allowedNTs; FIsReadonly:= false; end; function TdomNamedCMNodeMap.getOwnerNode: TdomCMNode; begin Result:= FOwnerNode; end; function TdomNamedCMNodeMap.RemoveItem(const arg: TdomCMNode): TdomCMNode; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if FCMNodeList.IndexOf(arg) = -1 then raise ENot_Found_Err.create('Node not found error.'); Result:= arg; FCMNodeList.Remove(arg); Result.FParentNode:= nil; end; procedure TdomNamedCMNodeMap.setIsReadonly(const value: boolean); begin FIsReadonly:= value; end; function TdomNamedCMNodeMap.GetNamedIndex(const name: wideString): integer; var i: integer; begin result:= -1; for i:= 0 to FCMNodeList.count-1 do if (TdomCMNode(FCMNodeList[i]).NodeName = name) and (TdomCMNode(FCMNodeList[i]).NodeType in FAllowedNodeTypes) then begin Result:= i; break; end; end; function TdomNamedCMNodeMap.GetNamedItem(const name: wideString): TdomCMNode; var i: integer; begin result:= nil; for i:= 0 to FCMNodeList.count-1 do if (TdomCMNode(FCMNodeList[i]).NodeName = name) and (TdomCMNode(FCMNodeList[i]).NodeType in FAllowedNodeTypes) then begin Result:= TdomCMNode(FCMNodeList[i]); break; end; end; function TdomNamedCMNodeMap.SetNamedItem(const arg: TdomCMNode): TdomCMNode; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if FOwner.OwnerCMObject <> arg.OwnerCMObject then raise EWrong_Document_Err.create('Wrong document error.'); if not (arg.NodeType in FAllowedNodeTypes) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); if assigned(arg.parentNode) then raise EInuse_Node_Err.create('Inuse node error.'); if assigned(GetNamedItem(arg.NodeName)) then Result:= RemoveNamedItem(arg.NodeName) else Result:= nil; FCMNodeList.Add(arg); arg.FParentNode:= nil; end; function TdomNamedCMNodeMap.RemoveNamedItem(const name: wideString): TdomCMNode; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); Result:= getNamedItem(name); if not assigned(Result) then raise ENot_Found_Err.create('Node not found error.'); FCMNodeList.Remove(Result); end; // ++++++++++++++++++++++ TdomNamedCMAttributeMap ++++++++++++++++++++++ constructor TdomNamedCMAttributeMap.create(const aOwner: TdomCMObject); begin inherited create; FOwner:= aOwner; FCMAttributesList:= TList.create; end; destructor TdomNamedCMAttributeMap.destroy; begin FCMAttributesList.free; inherited destroy; end; function TdomNamedCMAttributeMap.GetLength: integer; begin result:= FCMAttributesList.count; end; function TdomNamedCMAttributeMap.item(const index: integer): TdomCMAttribute; begin if (index < 0) or (index + 1 > FCMAttributesList.count) then Result:= nil else Result:= TdomCMAttribute(FCMAttributesList.Items[index]); end; function TdomNamedCMAttributeMap.GetNamedItem(const elementName, attributeName: wideString): TdomCMAttribute; var i: integer; cmAttr: TdomCMAttribute; begin result:= nil; for i:= 0 to FCMAttributesList.count-1 do begin cmAttr:= TdomCMAttribute(FCMAttributesList[i]); if (cmAttr.elementName = elementName) and (cmAttr.attributeName = attributeName) then begin Result:= cmAttr; break; end; end; end; function TdomNamedCMAttributeMap.appendNamedItem(const arg: TdomCMAttribute): boolean; begin if FOwner.OwnerCMObject <> arg.OwnerCMObject then raise EWrong_Document_Err.create('Wrong document error.'); if assigned(arg.parentNode) then raise EInuse_Node_Err.create('Inuse node error.'); if assigned(GetNamedItem(arg.elementName,arg.attributeName)) then begin result:= false; end else begin result:= true; FCMAttributesList.Add(arg); arg.FParentNode:= FOwner; arg.FCMObject:= FOwner; end; {if ...} end; function TdomNamedCMAttributeMap.removeLastItem: TdomCMAttribute; begin with FCMAttributesList do begin result:= TdomCMAttribute(Last); if not assigned(result) then raise ENot_Found_Err.create('Node not found error.'); remove(Last); end; Result.FCMObject:= nil; Result.FParentNode:= nil; end; // +++++++++++++++++++++++ TdomNamedCMEntityMap +++++++++++++++++++++++ constructor TdomNamedCMEntityMap.create(const aOwner: TdomCMObject); begin inherited create; FOwner:= aOwner; FCMEntitiesList:= TList.create; end; destructor TdomNamedCMEntityMap.destroy; begin FCMEntitiesList.free; inherited destroy; end; function TdomNamedCMEntityMap.GetLength: integer; begin result:= FCMEntitiesList.count; end; function TdomNamedCMEntityMap.item(const index: integer): TdomCMEntity; begin if (index < 0) or (index + 1 > FCMEntitiesList.count) then Result:= nil else Result:= TdomCMEntity(FCMEntitiesList.Items[index]); end; function TdomNamedCMEntityMap.GetNamedItem(const name: wideString): TdomCMEntity; var i: integer; begin result:= nil; for i:= 0 to FCMEntitiesList.count-1 do if (TdomCMEntity(FCMEntitiesList[i]).NodeName = name) then begin Result:= TdomCMEntity(FCMEntitiesList[i]); break; end; end; function TdomNamedCMEntityMap.appendNamedItem(const arg: TdomCMEntity): boolean; begin if FOwner.OwnerCMObject <> arg.OwnerCMObject then raise EWrong_Document_Err.create('Wrong document error.'); if assigned(arg.parentNode) then raise EInuse_Node_Err.create('Inuse node error.'); if assigned(GetNamedItem(arg.NodeName)) then begin result:= false; end else begin // Append 'arg': result:= true; FCMEntitiesList.Add(arg); arg.FParentNode:= FOwner; end; {if ...} end; function TdomNamedCMEntityMap.removeLastItem: TdomCMEntity; begin with FCMEntitiesList do begin result:= TdomCMEntity(Last); if not assigned(result) then raise ENot_Found_Err.create('Node not found error.'); remove(Last); end; Result.FParentNode:= nil; end; //+++++++++++++++++++++++++++ TdomCMNode +++++++++++++++++++++++++++++++ constructor TdomCMNode.create(const aOwner: TdomCustomCMObject); begin inherited create; FCMObject:= aOwner; FParentNode:= nil; FCMNodeListing:= TList.create; FCMNodeList:= TdomCMNodeList.create(FCMNodeListing); FNodeName:= ''; FNodeValue:= ''; FNodeType:= ctUnknown; FAllowedChildTypes:= []; FIsReadonly:= false; end; destructor TdomCMNode.destroy; begin FCMNodeListing.free; FCMNodeList.free; inherited destroy; end; procedure TdomCMNode.clear; var oldCMChild: TdomCMNode; begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); while hasChildNodes do begin firstChild.setIsReadonly(false); oldCMChild:= removeChild(firstChild); OwnerCMObject.FreeAllCMNodes(oldCMChild); end; end; procedure TdomCMNode.makeChildrenReadonly; var i: integer; begin with childnodes do for i:= 0 to pred(length) do with item(i) do begin item(i).setIsReadonly(true); item(i).makeChildrenReadonly; end; end; function TdomCMNode.GetNodeName: wideString; begin Result:= FNodeName; end; function TdomCMNode.GetNodeValue: wideString; begin Result:= FNodeValue; end; procedure TdomCMNode.SetNodeValue(const value: wideString); begin if isReadonly = true then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); FNodeValue:= value; end; function TdomCMNode.GetCMNodeType: TdomCMNodeType; begin Result:= FNodeType; end; function TdomCMNode.GetParentNode: TdomCMNode; begin Result:= FParentNode; end; function TdomCMNode.GetCMObject: TdomCustomCMObject; begin Result:= FCMObject; end; function TdomCMNode.validate: boolean; begin raise ENot_Supported_Err.create('Not supported error.'); end; function TdomCMNode.sendErrorNotification(const xmlErrorType: TXmlErrorType; const relCMNode: TdomCMNode): boolean; // Used to centralize code for sending error notifications to the DomImplementation. // Usually used during validation. var domImpl: TDomImplementation; error: TdomError; begin if assigned(ownerCMObject) then domImpl:= ownerCMObject.domImplementation else domImpl:= nil; error:= TdomError.create(xmlErrorType,-1,-1,-1,-1,-1,'',relCMNode,nil,''); try if assigned(domImpl) then begin result:= domImpl.handleError(domImpl,error); end else if error.severity = DOM_SEVERITY_FATAL_ERROR then result:= false else result:= true; finally error.free; end; end; function TdomCMNode.getChildNodes: TdomCMNodeList; begin Result:= FCMNodeList; end; function TdomCMNode.getFirstChild: TdomCMNode; begin if FCMNodeListing.count = 0 then Result:= nil else Result:= TdomCMNode(FCMNodeListing.First); end; function TdomCMNode.getLastChild: TdomCMNode; begin if FCMNodeListing.count = 0 then Result:= nil else Result:= TdomCMNode(FCMNodeListing.Last); end; function TdomCMNode.getNextSibling: TdomCMNode; begin if assigned(ParentNode) then Result:= ParentNode.ChildNodes.Item(ParentNode.ChildNodes.IndexOf(Self)+1) else Result:= nil; end; function TdomCMNode.getPreviousSibling: TdomCMNode; begin if assigned(ParentNode) then Result:= ParentNode.ChildNodes.Item(ParentNode.ChildNodes.IndexOf(Self)-1) else Result:= nil; end; procedure TdomCMNode.setIsReadonly(const value: boolean); begin FIsReadonly:= value; end; function TdomCMNode.insertBefore(const newChild, refChild: TdomCMNode): TdomCMNode; begin if not assigned(newChild) then raise ENot_Supported_Err.create('Not supported error.'); if not (newChild.NodeType in FAllowedChildTypes) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); if OwnerCMObject <> newChild.OwnerCMObject then raise EWrong_Document_Err.create('Wrong document error.'); if isAncestor(newChild) or (newChild = self) or (newChild = refChild ) // Test for circularity then raise EHierarchy_Request_Err.create('Hierarchy request error.'); if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if assigned(newChild.ParentNode) then if newChild.ParentNode.isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if assigned(refChild) then if FCMNodeListing.IndexOf(refChild) = -1 then raise ENot_Found_Err.create('Node not found error.'); Result:= newChild; if NewChild is TdomCMFragment then while NewChild.HasChildNodes do insertBefore(newChild.ChildNodes.Item(0),refChild) else begin if assigned(newChild.parentNode) then newChild.parentNode.RemoveChild(newChild); if assigned(refChild) then FCMNodeListing.Insert(FCMNodeListing.IndexOf(refChild),newChild) else FCMNodeListing.Add(newChild); NewChild.FParentNode:= self; end; end; function TdomCMNode.replaceChild(const newChild, oldChild: TdomCMNode): TdomCMNode; var refChild: TdomCMNode; begin if not ( assigned(newChild) and assigned(oldChild) ) then raise ENot_Supported_Err.create('Not supported error.'); if not (newChild.NodeType in FAllowedChildTypes) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); if OwnerCMObject <> newChild.OwnerCMObject then raise EWrong_Document_Err.create('Wrong document error.'); if IsAncestor(newChild) or (newChild = self) // Test for circularity then raise EHierarchy_Request_Err.create('Hierarchy request error.'); if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if assigned(newChild.ParentNode) then if newChild.ParentNode.isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if FCMNodeListing.IndexOf(oldChild) = -1 then raise ENot_Found_Err.create('Node not found error.'); Result:= oldChild; if newChild = oldChild then exit; if assigned(newChild.parentNode) then newChild.parentNode.RemoveChild(newChild); refChild:= oldChild.NextSibling; RemoveChild(oldChild); if assigned(refChild) then insertBefore(newChild,refChild) else appendChild(newChild); end; function TdomCMNode.removeChild(const oldChild: TdomCMNode): TdomcmNode; begin if not assigned(oldChild) then raise ENot_Supported_Err.create('Not supported error.'); if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if FCMNodeListing.IndexOf(oldChild) = -1 then raise ENot_Found_Err.create('Node not found error.'); Result:= oldChild; FCMNodeListing.Remove(oldChild); OldChild.FParentNode:= nil; end; function TdomCMNode.appendChild(const newChild: TdomCMNode): TdomCMNode; begin if not assigned(newChild) then raise ENot_Supported_Err.create('Not supported error.'); if not (newChild.NodeType in FAllowedChildTypes) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); if OwnerCMObject <> newChild.OwnerCMObject then raise EWrong_Document_Err.create('Wrong document error.'); // Test for circularity: if IsAncestor(newChild) or (newChild = self) then raise EHierarchy_Request_Err.create('Hierarchy request error.'); if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if assigned(newChild.ParentNode) then if newChild.ParentNode.isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); Result:= newChild; if NewChild is TdomCMFragment then while NewChild.HasChildNodes do appendChild(newChild.ChildNodes.Item(0)) else begin if assigned(newChild.parentNode) then newChild.parentNode.RemoveChild(newChild); FCMNodeListing.Add(newChild); NewChild.FParentNode:= self; end; end; function TdomCMNode.HasChildNodes: boolean; begin if FCMNodeListing.count = 0 then result:= false else result:= true; end; function TdomCMNode.CloneNode(const deep: boolean): TdomCmNode; var newChildNode: TdomCMNode; i: integer; begin Result:= OwnerCMObject.DuplicateCMNode(self); if deep then for i:= 0 to ChildNodes.Length-1 do begin newChildNode:= ChildNodes.Item(i).CloneNode(true); Result.appendChild(newChildNode); end; end; function TdomCMNode.IsAncestor(const AncestorNode: TdomCMNode): boolean; var NewAncestor: TdomCMNode; List1: TList; begin Result:= false; NewAncestor:= ParentNode; List1:= TList.create; List1.clear; try while assigned(NewAncestor) do begin {Ciculation test:} if List1.IndexOf(NewAncestor) > -1 then raise EHierarchy_Request_Err.create('Hierarchy request error.'); List1.Add(NewAncestor); if NewAncestor = AncestorNode then begin Result:= true; break; end; NewAncestor:= NewAncestor.ParentNode; end; finally List1.free; end; end; // +++++++++++++++++++++++++++ TdomCMComment +++++++++++++++++++++++++++ constructor TdomCMComment.create(const aOwner: TdomCustomCMObject); begin inherited create(aOwner); FNodeName:= '#comment'; FNodeValue:= ''; FNodeType:= ctComment; FAllowedChildTypes:= []; end; function TdomCMComment.GetData: wideString; begin Result:= NodeValue; end; procedure TdomCMComment.SetData(const value: wideString); begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); NodeValue:= value; end; function TdomCMComment.GetLength: integer; begin Result:= System.Length(Data); end; function TdomCMComment.SubstringData(const offset, count: integer):wideString; var len: integer; begin if(offset < 0) or (offset > Length) or (count < 0) then raise EIndex_Size_Err.create('Index size error.'); // Make sure, that the length of the wideString is not // exeeded, when using count and offset: len:= Length-Offset; if count < len then len:= count; setString(Result,PWideChar(Data)+Offset,len); end; procedure TdomCMComment.AppendData(const arg: wideString); begin Data:= concat(Data,arg); end; procedure TdomCMComment.InsertData(const offset: integer; const arg: wideString); begin ReplaceData(offset,0,arg); end; procedure TdomCMComment.DeleteData(const offset, count: integer); begin ReplaceData(offset,count,''); end; procedure TdomCMComment.replaceData(const offset, count: integer; const arg: wideString); var len: integer; Data1,Data2:wideString; begin if(offset < 0) or (offset > Length) or (count < 0) then raise EIndex_Size_Err.create('Index size error.'); // Make sure, that the length of the wideString is not // exeeded, when using count and offset: len:= Length-Offset; if count < len then len:= count; Data1:= SubstringData(0,offset); Data2:= SubstringData(offset+len,Length-offset-len); Data:= concat(Data1,arg,Data2); end; function TdomCMComment.validate: boolean; begin result:= true; end; //++++++++++++++++++ TdomCMProcessingInstruction +++++++++++++++++++++++ constructor TdomCMProcessingInstruction.create(const aOwner: TdomCustomCMObject; const targ: wideString); begin if not IsXmlPITarget(targ) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FNodeName:= targ; FNodeValue:= ''; FNodeType:= ctProcessingInstruction; FAllowedChildTypes:= []; end; function TdomCMProcessingInstruction.GetTarget: wideString; begin Result:= FNodeName; end; function TdomCMProcessingInstruction.GetData: wideString; begin Result:= FNodeValue; end; procedure TdomCMProcessingInstruction.SetData(const value: wideString); begin if isReadonly then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); FNodeValue:= value; end; function TdomCMProcessingInstruction.validate: boolean; begin result:= true; end; // +++++++++++++++++++++++++ TdomCustomCMObject ++++++++++++++++++++++++ constructor TdomCustomCMObject.create(const aOwner: TdomImplementation; const sysId: wideString); begin inherited create(self); FDomImpl:= aOwner; FNodeValue:= ''; FCreatedNodes:= TList.create; FSystemId:= sysId; FAllowedChildTypes:= []; end; destructor TdomCustomCMObject.destroy; var i: integer; begin for i := 0 to pred(FCreatedNodes.Count) do TdomCMNode(FCreatedNodes[i]).free; FCreatedNodes.free; inherited destroy; end; procedure TdomCustomCMObject.SetNodeValue(const value: wideString); begin end; function TdomCustomCMObject.CreateCMAttributeDefinition(const name, attType, defaultDecl, attValue: wideString) : TdomCMAttrDefinition; begin Result:= TdomCMAttrDefinition.create(self,name,attType,defaultDecl,attValue); FCreatedNodes.add(Result); end; function TdomCustomCMObject.CreateCMAttributeList(const name: wideString): TdomCMAttrList; begin Result:= TdomCMAttrList.create(self,name); FCreatedNodes.add(Result); end; function TdomCustomCMObject.CreateCMChoiceParticle(const freq: wideString): TdomCMChoiceParticle; begin Result:= TdomCMChoiceParticle.create(self,freq); FCreatedNodes.add(Result); end; function TdomCustomCMObject.CreateCMComment(const Data: wideString): TdomCMComment; begin Result:= TdomCMComment.create(self); Result.Data:= Data; FCreatedNodes.add(Result); end; function TdomCustomCMObject.CreateCMElementParticle(const name, freq: wideString): TdomCMElementParticle; begin Result:= TdomCMElementParticle.create(self,name,freq); FCreatedNodes.add(Result); end; function TdomCustomCMObject.CreateCMElementTypeDeclaration(const name: wideString; const contspecType: TdomContentspecType): TdomCMElementTypeDeclaration; begin Result:= TdomCMElementTypeDeclaration.create(self,name,contspecType); FCreatedNodes.add(Result); end; function TdomCustomCMObject.createCMExtEntityDeclaration(const name, pubId, sysId: wideString): TdomCMEntityDeclaration; begin Result:= TdomCMEntityDeclaration.createExtParsed(self,name,pubId,sysId); FCreatedNodes.add(Result); end; function TdomCustomCMObject.createCMExtParameterEntityDeclaration(const name, pubId, sysId: wideString): TdomCMParameterEntityDeclaration; begin Result:= TdomCMParameterEntityDeclaration.createExtParsed(self,name,pubId,sysId); FCreatedNodes.add(Result); end; function TdomCustomCMObject.createCMExtUnparsedEntityDeclaration(const name, pubId, sysId, notaName: wideString): TdomCMEntityDeclaration; begin Result:= TdomCMEntityDeclaration.createExtUnparsed(self,name,pubId,sysId,notaName); FCreatedNodes.add(Result); end; function TdomCustomCMObject.CreateCMFragment: TdomCMFragment; begin Result:= TdomCMFragment.create(self); FCreatedNodes.add(Result); end; function TdomCustomCMObject.createCMIntEntityDeclaration(const name, entityValue: wideString): TdomCMEntityDeclaration; begin Result:= TdomCMEntityDeclaration.create(self,name,entityValue); FCreatedNodes.add(Result); end; function TdomCustomCMObject.createCMIntParameterEntityDeclaration(const name, entityValue: wideString): TdomCMParameterEntityDeclaration; begin Result:= TdomCMParameterEntityDeclaration.create(self,name,entityValue); FCreatedNodes.add(Result); end; function TdomCustomCMObject.CreateCMNameParticle(const name: wideString): TdomCMNameParticle; begin Result:= TdomCMNameParticle.create(self,name); FCreatedNodes.add(Result); end; function TdomCustomCMObject.CreateCMNmtokenParticle(const name: wideString): TdomCMNmtokenParticle; begin Result:= TdomCMNmtokenParticle.create(self,name); FCreatedNodes.add(Result); end; function TdomCustomCMObject.CreateCMNotationDeclaration(const name, pubId, sysId: wideString): TdomCMNotationDeclaration; begin Result:= TdomCMNotationDeclaration.create(self,name,pubId,sysId); FCreatedNodes.add(Result); end; function TdomCustomCMObject.CreateCMParameterEntityReference(const name: wideString): TdomCMParameterEntityReference; begin Result:= TdomCMParameterEntityReference.create(self,name); FCreatedNodes.add(Result); end; function TdomCustomCMObject.CreateCMPcdataChoiceParticle: TdomCMPcdataChoiceParticle; begin Result:= TdomCMPcdataChoiceParticle.create(self,'*'); FCreatedNodes.add(Result); end; function TdomCustomCMObject.CreateCMProcessingInstruction(const targ, Data : wideString): TdomCMProcessingInstruction; begin Result:= TdomCMProcessingInstruction.create(self,targ); Result.Data:= Data; FCreatedNodes.add(Result); end; function TdomCustomCMObject.CreateCMSequenceParticle(const freq: wideString): TdomCMSequenceParticle; begin Result:= TdomCMSequenceParticle.create(self,freq); FCreatedNodes.add(Result); end; function TdomCustomCMObject.DuplicateCMNode(const node: TdomCMNode): TdomCMNode; // Creates a new CMNode of the same type and properties than 'Node', // except that the new CMNode has no parent and no child nodes. var i: integer; newChild: TdomCMNode; begin case node.NodeType of ctUnknown: raise ENot_Supported_Err.create('Not supported error.'); ctParameterEntityReference: begin Result:= CreateCMParameterEntityReference((node as TdomCMParameterEntityReference).NodeName); Result.FNodeValue:= FNodeValue; end; ctEntityDeclaration: if (node as TdomCMEntityDeclaration).isParsedEntity then begin if (node as TdomCMEntityDeclaration).entityType = etExternal_Entity then begin Result:= CreateCMExtEntityDeclaration((node as TdomCMEntityDeclaration).NodeName, (node as TdomCMEntityDeclaration).publicId, (node as TdomCMEntityDeclaration).systemId); end else begin Result:= CreateCMIntEntityDeclaration((node as TdomCMEntityDeclaration).NodeName, (node as TdomCMEntityDeclaration).NodeValue); end; end else begin Result:= createCMExtUnparsedEntityDeclaration((node as TdomCMEntityDeclaration).NodeName, (node as TdomCMEntityDeclaration).publicId, (node as TdomCMEntityDeclaration).systemId, (node as TdomCMEntityDeclaration).notationName); end; ctParameterEntityDeclaration: if (node as TdomCMParameterEntityDeclaration).entityType = etExternal_Entity then begin Result:= CreateCMExtParameterEntityDeclaration((node as TdomCMParameterEntityDeclaration).NodeName, (node as TdomCMParameterEntityDeclaration).publicId, (node as TdomCMParameterEntityDeclaration).systemId); end else begin Result:= CreateCMIntParameterEntityDeclaration((node as TdomCMParameterEntityDeclaration).NodeName, (node as TdomCMParameterEntityDeclaration).NodeValue); end; ctProcessingInstruction: Result:= CreateCMProcessingInstruction((node as TdomCMProcessingInstruction).Target, (node as TdomCMProcessingInstruction).Data); ctComment: Result:= CreateCMComment((node as TdomCMComment).Data); ctObject: Result:= TdomCMObject.create((node as TdomCMObject).FDomImpl, (node as TdomCMObject).systemId); ctExternalObject: Result:= TdomCMExternalObject.create((node as TdomCMExternalObject).FDomImpl, (node as TdomCMExternalObject).FPublicId, (node as TdomCMExternalObject).FSystemId); ctInternalObject: Result:= TdomCMInternalObject.create((node as TdomCMInternalObject).FDomImpl, (node as TdomCMInternalObject).FPublicId, (node as TdomCMInternalObject).FSystemId); ctFragment: Result:= CreateCMFragment; ctNotationDeclaration: Result:= CreateCMNotationDeclaration((node as TdomCMNotationDeclaration).NodeName, (node as TdomCMNotationDeclaration).publicId, (node as TdomCMNotationDeclaration).systemId); ctElementTypeDeclaration: Result:= CreateCMElementTypeDeclaration((node as TdomCMElementTypeDeclaration).NodeName, (node as TdomCMElementTypeDeclaration).contentspecType); ctSequenceParticle: Result:= CreateCMSequenceParticle((node as TdomCMSequenceParticle).Frequency); ctPcdataChoiceParticle: Result:= CreateCMPcdataChoiceParticle; ctChoiceParticle: Result:= CreateCMChoiceParticle((node as TdomCMChoiceParticle).Frequency); ctElementParticle: Result:= CreateCMElementParticle((node as TdomCMElementParticle).NodeName, (node as TdomCMElementParticle).Frequency); ctAttributeList: begin Result:= CreateCMAttributeList((node as TdomCMAttrList).NodeName); {duplicate attribute definitions:} for i:= 0 to pred(node.ChildNodes.Length) do begin NewChild:= DuplicateCMNode(node.ChildNodes.Item(i)); Result.appendChild(NewChild); end; end; ctAttributeDefinition: begin Result:= CreateCMAttributeDefinition((node as TdomCMAttrDefinition).NodeName, (node as TdomCMAttrDefinition).AttributeType, (node as TdomCMAttrDefinition).DefaultDeclaration, (node as TdomCMAttrDefinition).NodeValue); {duplicate the children of the attribute definition node:} for i:= 0 to node.ChildNodes.Length-1 do begin newChild:= DuplicateCMNode(node.ChildNodes.Item(i)); Result.appendChild(newChild); end; end; ctNameParticle: Result:= CreateCMNameParticle((node as TdomCMNameParticle).NodeName); ctNmtokenParticle: Result:= CreateCMNmtokenParticle((node as TdomCMNmtokenParticle).NodeName); else raise ENot_Supported_Err.create('Not supported error.'); end; end; procedure TdomCustomCMObject.FreeAllCMNodes(var CMNode: TdomCMNode); var index: integer; oldChild: TdomCMNode; begin if not assigned(CMNode) then exit; if CMNode.OwnerCMObject <> Self then raise EWrong_Document_Err.create('Wrong document error.'); if CMNode = Self then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); if assigned(CMNode.ParentNode) then raise EInuse_Node_Err.create('Inuse node error.'); while CMnode.HasChildNodes do begin CMnode.FirstChild.setIsReadonly(false); oldChild:= CMnode.RemoveChild(CMnode.FirstChild); CMnode.OwnerCMObject.FreeAllCMNodes(oldChild); end; index:= FCreatedNodes.IndexOf(CMNode); CMNode.free; FCreatedNodes.Delete(index); CMNode:= nil; end; procedure TdomCustomCMObject.getValueOfPE(const name: wideString; var value: wideString; var error: TXmlErrorType); var InputSrc: TXmlInputSource; stream: TStream; PId,SId: wideString; action: TXmlParserAction; i: integer; begin value:= ''; error:= ET_PARAMETER_ENTITY_DECL_NOT_FOUND; for i:= 0 to pred(FCreatedNodes.Count) do begin if TdomCMNode(FCreatedNodes[i]).nodeType = ctParameterEntityDeclaration then begin with TdomCMParameterEntityDeclaration(FCreatedNodes[i]) do begin if nodeName = name then begin if entityType = etInternal_Entity then begin value:= nodeValue; error:= ET_NONE; exit; end else begin // Resolve value of external parsed entity: if not ( (publicId = '') and (systemId = '')) then begin stream:= nil; PId:= publicId; SId:= systemId; action:= paFail; try if assigned(domImplementation) then domImplementation.doExternalParsedEntity(self.systemId,PId,SId,stream,action); if action = paFail then begin error:= ET_UNRESOLVABLE_PARAMETER_ENTITY_REFERENCE; exit; end else begin // convert external entity value to UTF-16BE: if assigned(stream) then begin InputSrc:= TXmlInputSource.create(stream,PId,SId,1); try if InputSrc.hasMalformedDecl or not ( InputSrc.declType in [ DT_TEXT_DECLARATION, DT_XML_OR_TEXT_DECLARATION, DT_UNSPECIFIED] ) then begin value:= ''; error:= ET_INVALID_TEXT_DECL; end else begin value:= InputSrc.streamAsWideString; error:= ET_NONE; end; {if ... else ...} exit; finally InputSrc.free; end; {try} end; error:= ET_NONE; exit; end; {if ... else ...} finally if assigned(stream) then stream.free; end; end; end; end; end; end; end; end; function TdomCustomCMObject.hasPEDeclaration(const name: wideString): boolean; var i: integer; begin result:= false; for i:= 0 to pred(FCreatedNodes.Count) do with TdomCMNode(FCreatedNodes[i]) do if nodeType = ctParameterEntityDeclaration then if nodeName = name then begin result:= true; exit; end; end; // ++++++++++++++++++++++++++++ TdomCMObject +++++++++++++++++++++++++++ constructor TdomCMObject.create(const aOwner: TdomImplementation; const sysId: wideString); begin inherited; FNodeName:= '#cm-object'; FNodeType:= ctObject; FAllowedChildTypes:= []; FAssociatedDocument:= nil; FCMExternal:= nil; FCMInternal:= nil; FNotationsListing:= TList.create; FNotationsList:= TdomNamedCMNodeMap.create(self,self,FNotationsListing,[ctNotation]); FElementTypesListing:= TList.create; FElementTypesList:= TdomNamedCMNodeMap.create(self,self,FElementTypesListing,[ctElementTypeDeclaration]); FAttributesList:= TdomNamedCMAttributeMap.create(self); FEntitiesList:= TdomNamedCMEntityMap.create(self); setPredefinedEntities; end; destructor TdomCMObject.destroy; begin FAttributesList.free; FEntitiesList.free; FNotationsListing.free; FNotationsList.free; FElementTypesListing.free; FElementTypesList.free; inherited destroy; end; procedure TdomCMObject.clear; begin clearAttributes; clearElementtypes; clearEntities; clearNotations; inherited clear; end; procedure TdomCMObject.clearAttributes; var removedAttribute: TdomCMAttribute; begin while attributes.length > 0 do begin removedAttribute:= attributes.removeLastItem; FCreatedNodes.remove(removedAttribute); removedAttribute.free; end; end; procedure TdomCMObject.clearElementTypes; var i: integer; begin for i:= pred(FElementTypesListing.count) downto 0 do FCreatedNodes.remove(FElementTypesListing[i]); FElementTypesListing.clear; end; procedure TdomCMObject.clearEntities; var removedEntity: TdomCMEntity; begin while Entities.length > 0 do begin removedEntity:= Entities.removeLastItem; FCreatedNodes.remove(removedEntity); removedEntity.free; end; end; procedure TdomCMObject.clearNotations; var i: integer; begin for i:= pred(FNotationsListing.count) downto 0 do FCreatedNodes.remove(FNotationsListing[i]); FNotationsListing.clear; end; function TdomCMObject.duplicateCMNode(const node: TdomCMNode): TdomCMNode; begin case node.NodeType of ctAttribute: result:= createCMAttribute((node as TdomCMAttribute).elementName, (node as TdomCMAttribute).attributeName, (node as TdomCMAttribute).attributeType, (node as TdomCMAttribute).defaultDeclaration, (node as TdomCMAttribute).NodeValue); ctEntity: if (node as TdomCMEntity).entityType = etInternal_Entity then begin result:= createCMIntEntity((node as TdomCMEntity).nodeName, (node as TdomCMEntity).literalValue); end else begin if (node as TdomCMEntity).isParsedEntity then result:= createCMExtParsedEntity((node as TdomCMEntity).nodeName, (node as TdomCMEntity).publicId, (node as TdomCMEntity).systemId) else result:= createCMExtUnparsedEntity((node as TdomCMEntity).nodeName, (node as TdomCMEntity).publicId, (node as TdomCMEntity).systemId, (node as TdomCMEntity).notationName); end; ctNotation: result:= createCMNotation((node as TdomCMNotation).NodeName, (node as TdomCMNotation).publicId, (node as TdomCMNotation).systemId); else result:= inherited DuplicateCMNode(node); end; end; function TdomCMObject.createCMAttribute(const elementName, attributeName, attType, defaultDecl, attValue: wideString): TdomCMAttribute; begin Result:= TdomCMAttribute.create(self,elementName,attributeName,attType,defaultDecl,attValue); FCreatedNodes.add(Result); end; function TdomCMObject.createCMExtParsedEntity(const name, pubId, sysId: wideString): TdomCMEntity; begin Result:= TdomCMEntity.createExtParsed(self,name,pubId,sysId); FCreatedNodes.add(Result); end; function TdomCMObject.createCMExtUnparsedEntity(const name, pubId, sysId, notaName: wideString): TdomCMEntity; begin Result:= TdomCMEntity.createExtUnparsed(self,name,pubId,sysId,notaName); FCreatedNodes.add(Result); end; function TdomCMObject.createCMIntEntity(const name, literalValue: wideString): TdomCMEntity; begin Result:= TdomCMEntity.create(self,name,literalValue); FCreatedNodes.add(Result); end; function TdomCMObject.CreateCMNotation(const name, pubId, sysId: wideString): TdomCMNotation; begin Result:= TdomCMNotation.create(self,name,pubId,sysId); FCreatedNodes.add(Result); end; function TdomCMObject.setPredefinedEntities: boolean; function testGtAposQuot(const entName, litVal, CdataVal: wideString): boolean; var newEntity, oldEntity: TdomCMEntity; ok: boolean; begin result:= true; oldEntity:= Entities.GetNamedItem(entName); if assigned(oldEntity) then begin try ok:= (oldEntity.replacementText = CdataVal); except ok:= false; end; if not ok then begin sendErrorNotification(ET_WRONG_DECL_OF_PREDEFINED_ENTITY,oldEntity); result:= false; end; end else begin newEntity:= CreateCMIntEntity(entName,litVal); Entities.appendNamedItem(newEntity); end; end; function testLtAmp(const entName, litVal: wideString; const charValue: integer): boolean; var newEntity, oldEntity: TdomCMEntity; ok: boolean; begin result:= true; oldEntity:= Entities.GetNamedItem(entName); if assigned(oldEntity) then begin try ok:= (XmlCharRefToInt(oldEntity.replacementText) = charValue); except ok:= false; end; if not ok then begin sendErrorNotification(ET_WRONG_DECL_OF_PREDEFINED_ENTITY,oldEntity); result:= false; end; end else begin newEntity:= CreateCMIntEntity(entName,litVal); Entities.appendNamedItem(newEntity); end; end; begin result:= true; if not testLtAmp('lt','&#60;',60) then result:= false; if not testGtAposQuot('gt','>',#62) then result:= false; if not testLtAmp('amp','&#38;',38) then result:= false; if not testGtAposQuot('apos',''',#39) then result:= false; if not testGtAposQuot('quot','"',#34) then result:= false; end; function TdomCMObject.prepareCM: boolean; var dtdAnalyzer: TXmlCMAnalyzer; begin result:= true; clearEntities; clearAttributes; clearElementTypes; clearNotations; dtdAnalyzer:= TXmlCMAnalyzer.create(nil); try dtdAnalyzer.DOMImpl:= domImplementation; if assigned(internalCM) then result:= dtdAnalyzer.analyzeCM(internalCM,self); if result and assigned(externalCM) then result:= dtdAnalyzer.analyzeCM(externalCM,self); finally dtdAnalyzer.free; end; if result then result:= setPredefinedEntities; if not result then begin clearEntities; clearAttributes; clearElementTypes; clearNotations; end; end; function TdomCMObject.prepare: boolean; begin result:= prepareCM; end; function TdomCMObject.removeExternalCM: TdomCMExternalObject; begin result:= FCMExternal; if assigned(FCMExternal) then FCMExternal.FAssociatedContentModel:= nil; FCMExternal:= nil; end; function TdomCMObject.setExternalCM(const arg: TdomCMExternalObject): TdomCMExternalObject; begin if assigned(arg) then if assigned(arg.associatedContentModel) then raise EInuse_Content_Model_Err.create('Inuse content model error.'); result:= removeExternalCM; FCMExternal:= arg; arg.FAssociatedContentModel:= self; end; function TdomCMObject.removeInternalCM: TdomCMInternalObject; begin result:= FCMInternal; if assigned(FCMInternal) then FCMInternal.FAssociatedContentModel:= nil; FCMInternal:= nil; end; function TdomCMObject.setInternalCM(const arg: TdomCMInternalObject): TdomCMInternalObject; begin if assigned(arg) then if assigned(arg.associatedContentModel) then raise EInuse_Content_Model_Err.create('Inuse content model error.'); result:= removeInternalCM; FCMInternal:= arg; arg.FAssociatedContentModel:= self; end; function TdomCMObject.validate: boolean; var i,j: integer; goOn, ok, typeMismatch: boolean; idNames, notationNames, notationTokens, enumerationTokens: TdomWideStringList; AType: wideString; Attri: TdomCMAttribute; EType: TdomCMElementTypeDeclaration; begin result:= true; if not prepareCM then begin result:= false; exit; end; if assigned(internalCM) then begin if not internalCM.validate then begin result:= false; exit; end; end; if assigned(externalCM) then begin if not externalCM.validate then begin result:= false; exit; end; end; for i:= 0 to pred(entities.length) do begin with entities.item(i) do begin resolve; // xxx necessary here? // VC: Notation Declared (XML 1.0, § 4.2.2) if not isParsedEntity then if notations.GetNamedIndex(notationName) = -1 then begin result:= false; goOn:= sendErrorNotification(ET_UNDECLARED_NOTATION_NAME,entities.item(i)); if not goOn then exit; end; end; {with ...} end; {for ...} IdNames:= TdomWideStringList.create; IdNames.Sorted:= true; IdNames.Duplicates:= dupError; NotationNames:= TdomWideStringList.create; NotationNames.Sorted:= true; NotationNames.Duplicates:= dupError; NotationTokens:= TdomWideStringList.create; NotationTokens.Sorted:= true; NotationTokens.Duplicates:= dupError; EnumerationTokens:= TdomWideStringList.create; EnumerationTokens.Sorted:= true; EnumerationTokens.Duplicates:= dupError; try for i:= 0 to pred(attributes.length) do begin Attri:= attributes.item(i); AType:= Attri.AttributeType; TypeMismatch:= false; if AType = 'ID' then begin // VC: One ID per Element Type (XML 1.0, § 3.3.1) try IdNames.Add(Attri.ElementName) except // xxx not elegant result:= false; goOn:= sendErrorNotification(ET_DUPLICATE_ID_ON_ELEMENT_TYPE,Attri); if not goOn then exit; end; end else if AType = 'NOTATION' then begin NotationTokens.clear; for j:= 0 to pred(Attri.childnodes.length) do begin // VC: Notation Attributes (XML 1.0, § 3.3.1) if notations.GetNamedIndex(Attri.childnodes.item(j).NodeName) = -1 then begin result:= false; goOn:= sendErrorNotification(ET_UNDECLARED_NOTATION_NAME,Attri.childnodes.item(j)); if not goOn then exit; end; // VC: No Duplicate Tokens (XML 1.0, 2nd ed., erratum 2) try NotationTokens.Add(Attri.childnodes.item(j).NodeName) except // xxx not elegant result:= false; goOn:= sendErrorNotification(ET_DUPLICATE_NOTATION_TOKEN,Attri.childnodes.item(j)); if not goOn then exit; end; end; {for ...} // VC: One Notation per Element Type (XML 1.0, § 3.3.1) try NotationNames.Add(Attri.ElementName) except // xxx not elegant result:= false; goOn:= sendErrorNotification(ET_DUPLICATE_NOTATION_ON_ELEMENT_TYPE,Attri); if not goOn then exit; end; // VC: No Notation on Empty Element (XML 1.0, § 3.3.1) EType:= (elementTypes.GetNamedItem(Attri.ElementName) as TdomCMElementTypeDeclaration); if assigned(EType) then begin if EType.ContentspecType = ctEmpty then begin result:= false; goOn:= sendErrorNotification(ET_NOTATION_ON_EMPTY_ELEMENT,Attri); if not goOn then exit; end; end; end else if AType = '' then begin if attri.NodeValue <> '' then begin ok:= false; EnumerationTokens.clear; with attri do begin for j:= 0 to pred(ChildNodes.length) do begin if ChildNodes.item(j).NodeName = NodeValue then begin ok:= true; break; end; // VC: No Duplicate Tokens (XML 1.0, 2nd ed., erratum 2) try EnumerationTokens.Add(childnodes.item(j).NodeName) except // xxx not elegant result:= false; goOn:= sendErrorNotification(ET_DUPLICATE_ENUMERATION_TOKEN,childnodes.item(j)); if not goOn then exit; end; if not result then break; end; end; {with ...} TypeMismatch:= not ok; // VC: Enumeration (XML 1.0, § 3.3.1) end; {if ...} end else if AType = 'IDREF' then begin if not (isXMLName(attri.NodeValue) or (attri.NodeValue = '')) then TypeMismatch:= true; // VC: IDREF (XML 1.0, § 3.3.1) end else if AType = 'IDREFS' then begin if not (isXMLNames(attri.NodeValue) or (attri.NodeValue = '')) then TypeMismatch:= true; // VC: IDREF (XML 1.0, § 3.3.1) end else if AType = 'ENTITY' then begin if not (isXMLName(attri.NodeValue) or (attri.NodeValue = '')) then TypeMismatch:= true; // VC: Entity (XML 1.0, § 3.3.1) end else if AType = 'ENTITIES' then begin if not (isXMLNames(attri.NodeValue) or (attri.NodeValue = '')) then TypeMismatch:= true; // VC: Entity (XML 1.0, § 3.3.1) end else if AType = 'NMTOKEN' then begin if not (isXmlNmtoken(attri.NodeValue) or (attri.NodeValue = '')) then TypeMismatch:= true; // VC: name Token (XML 1.0, § 3.3.1) end else if AType = 'NMTOKENS' then begin if not (isXmlNmtokens(attri.NodeValue) or (attri.NodeValue = '')) then TypeMismatch:= true; // VC: name Token (XML 1.0, § 3.3.1) end; if TypeMismatch then begin result:= false; goOn:= sendErrorNotification(ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH,attri); if not goOn then exit; end; end; {for ...} finally IdNames.free; NotationNames.free; NotationTokens.free; EnumerationTokens.free; end; end; // +++++++++++++++++++++++ TdomCustomCMIEObject +++++++++++++++++++++++ constructor TdomCustomCMIEObject.create(const aOwner: TdomImplementation; const pubId, sysId: wideString); begin inherited create(aOwner,sysId); FPublicId:= pubId; FAssociatedContentModel:= nil; end; function TdomCustomCMIEObject.validate: boolean; var i: integer; begin result:= true; for i:= 0 to pred(childnodes.length) do begin if not childnodes.item(i).validate then begin result:= false; exit; end; end; end; // +++++++++++++++++++++++ TdomCMInternalObject +++++++++++++++++++++++ constructor TdomCMInternalObject.create(const aOwner: TdomImplementation; const pubId, sysId: wideString); begin inherited create(aOwner,pubId,sysId); FNodeName:= '#cm-internal-object'; FNodeType:= ctInternalObject; FAllowedChildTypes:= [ctAttributeList, ctComment, ctElementTypeDeclaration, ctEntityDeclaration, ctNotationDeclaration, ctParameterEntityDeclaration, ctParameterEntityReference, ctProcessingInstruction]; end; // ++++++++++++++++++++++++ TdomCMExternalObject +++++++++++++++++++++++ constructor TdomCMExternalObject.create(const aOwner: TdomImplementation; const pubId, sysId: wideString); begin inherited create(aOwner,pubId,sysId); FNodeName:= '#cm-external-object'; FNodeType:= ctExternalObject; FEncoding:= ''; FVersion:= ''; FAllowedChildTypes:= [ctAttributeList, ctComment, ctElementTypeDeclaration, ctEntityDeclaration, ctNotationDeclaration, ctParameterEntityDeclaration, ctParameterEntityReference, ctProcessingInstruction]; end; // ++++++++++++++++++ TdomCMNotationDeclaration ++++++++++++++++++++++++ constructor TdomCMNotationDeclaration.create(const aOwner: TdomCustomCMObject; const name, pubId, sysId: wideString); begin if not IsXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); if not isXmlSystemChars(sysId) then raise EInvalid_Character_Err.create('Invalid character error.'); if not isXmlPubidChars(pubId) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FNodeName:= name; FNodeValue:= ''; FPublicId:= pubId; FSystemId:= sysId; FNodeType:= ctNotationDeclaration; FAllowedChildTypes:= []; end; procedure TdomCMNotationDeclaration.SetNodeValue(const value: wideString); begin end; function TdomCMNotationDeclaration.GetPublicId: wideString; begin Result:= FPublicId; end; function TdomCMNotationDeclaration.GetSystemId: wideString; begin Result:= FSystemId; end; function TdomCMNotationDeclaration.validate: boolean; begin result:= true; end; // +++++++++++++++++ TdomCMElementTypeDeclaration +++++++++++++++++++++++ constructor TdomCMElementTypeDeclaration.create(const aOwner: TdomCustomCMObject; const name: wideString; const contspecType: TdomContentspecType); begin if not IsXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FNodeName:= name; FNodeType:= ctElementTypeDeclaration; FContentspec:= contspecType; case contspecType of ctEmpty,ctAny: FAllowedChildTypes:= []; ctMixed: FAllowedChildTypes:= [ctPcdataChoiceParticle]; ctChildren: FAllowedChildTypes:= [ctSequenceParticle, ctChoiceParticle]; end; end; function TdomCMElementTypeDeclaration.GetContentspec: wideString; var XMLStream: TdomWideStringStream; begin XMLStream := TdomWideStringStream.create; try case ContentSpecType of ctEmpty: writeWideString(XMLStream, 'EMPTY '); ctAny: writeWideString(XMLStream, 'ANY '); ctMixed, ctChildren: (ChildNodes.Item(0) as TdomCMParticle).writeCode(XMLStream); end; {case ...} Result := XMLStream.DataString; finally XMLStream.Free; end; end; function TdomCMElementTypeDeclaration.GetContentspecType: TdomContentspecType; begin Result:= FContentspec; end; procedure TdomCMElementTypeDeclaration.SetNodeValue(const value: wideString); begin end; function TdomCMElementTypeDeclaration.appendChild(const newChild: TdomCMNode): TdomCMNode; begin if (contentspecType = ctEmpty) or (contentspecType = ctAny) or (hasChildNodes and (FirstChild <> newChild)) then raise ENot_Supported_Err.create('Not supported error.'); result:= inherited appendChild(newChild); end; function TdomCMElementTypeDeclaration.insertBefore(const newChild, refChild: TdomCMNode): TdomCMNode; begin if (contentspecType = ctEmpty) or (contentspecType = ctAny) or (hasChildNodes and (FirstChild <> newChild)) then raise ENot_Supported_Err.create('Not supported error.'); result:= inherited insertBefore(newChild,refChild); end; function TdomCMElementTypeDeclaration.validate: boolean; var i: integer; begin result:= true; for i:= 0 to pred(childnodes.length) do begin if not childnodes.item(i).validate then begin result:= false; exit; end; end; end; // +++++++++++++++++++++++ TdomCMAttrList ++++++++++++++++++++++++++++++ constructor TdomCMAttrList.create(const aOwner: TdomCustomCMObject; const name: wideString); begin if not IsXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FNodeName:= name; FNodeType:= ctAttributeList; FAllowedChildTypes:= [ctAttributeDefinition]; end; function TdomCMAttrList.validate: boolean; var i: integer; begin result:= true; for i:= 0 to pred(childnodes.length) do begin if not childnodes.item(i).validate then begin result:= false; exit; end; end; end; // ++++++++++++++++++++ TdomCMAttrDefinition ++++++++++++++++++++++++++ constructor TdomCMAttrDefinition.create(const aOwner: TdomCustomCMObject; const name, attType, defaultDecl, attValue: wideString); const sQuote: wideString = #$0027; dQuote: wideString = '"'; begin if not IsXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); if not ( (attType='') or (attType='NOTATION') or IsXmlStringType(attType) or IsXmlTokenizedType(attType) ) then raise EInvalid_Character_Err.create('Invalid character error.'); if not ( (defaultDecl = '#REQUIRED') or (defaultDecl = '#IMPLIED') or (defaultDecl = '#FIXED') or (defaultDecl = '') ) then raise EInvalid_Character_Err.create('Invalid character error.'); if ((defaultDecl = '#REQUIRED') or (defaultDecl = '#IMPLIED')) and (attValue <> '') then raise EInvalid_Character_Err.create('Invalid character error.'); if not ( IsXMLAttValue(concat(dQuote,attValue,dQuote)) or IsXMLAttValue(concat(sQuote,attValue,sQuote)) ) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FNodeName:= name; FAttributeType:= attType; FDefaultDeclaration:= defaultDecl; FNodeValue:= attValue; FNodeType:= ctAttributeDefinition; FParentAttributeList:= nil; FAllowedChildTypes:= []; if attType = '' then FAllowedChildTypes:= [ctNmtokenParticle]; if attType = 'NOTATION' then FAllowedChildTypes:= [ctNameParticle]; end; function TdomCMAttrDefinition.validate: boolean; var i: integer; particleNames: TdomWideStringList; begin result:= true; // VC: ID Attribute Default (XML 1.0, § 3.3.1) if (AttributeType = 'ID') and not ( (DefaultDeclaration = '#REQUIRED') or (DefaultDeclaration = '#IMPLIED') ) then begin result:= false; sendErrorNotification(ET_ID_NEITHER_IMPLIED_NOR_REQUIRED,self); end; // VC: No Duplicate Tokens (XML 1.0, 2nd Ed., Erratum 2) if hasChildNodes then begin particleNames:= TdomWideStringList.create; particleNames.Sorted:= true; particleNames.Duplicates:= dupError; try for i:= 0 to pred(childnodes.length) do begin try particleNames.Add(childnodes.item(i).nodeName); except // xxx not elegant result:= false; sendErrorNotification(ET_DUPLICATE_TOKENS,childnodes.item(i)); break; end; {try ... except ...} end; {for ...} finally particleNames.free; end; end; end; function TdomCMAttrDefinition.GetAttributeType: wideString; begin Result:= FAttributeType; end; function TdomCMAttrDefinition.GetDefaultDeclaration: wideString; begin Result:= FDefaultDeclaration; end; procedure TdomCMAttrDefinition.SetNodeValue(const value: wideString); begin end; // +++++++++++++++++++++++++ TdomCMParticle ++++++++++++++++++++++++++++ constructor TdomCMParticle.create(const aOwner: TdomCustomCMObject; const freq: wideString); begin if not ( (freq = '') or (freq = wideString('?')) or (freq = '*') or (freq = '+') ) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FNodeType:= ctUnknown; FAllowedChildTypes:= []; FFrequency:= freq; end; function TdomCMParticle.contentModelTest2(const source, rest: TdomWideStringList; const freq: wideString; var isNonDeterministic: boolean): boolean; begin raise EParserException.create('Parser exception in TdomCMParticle.contentModelTest'); end; function TdomCMParticle.contentModelTest(const source, rest: TdomWideStringList; var isNonDeterministic: boolean): boolean; var rest2: TdomWideStringList; begin result:= false; isNonDeterministic:= false; if Frequency = '' then begin result:= contentModelTest2(source,rest,'',isNonDeterministic); end else if Frequency = '?' then begin result:= contentModelTest2(source,rest,'?',isNonDeterministic); end else if Frequency = '+' then begin result:= contentModelTest2(source,rest,'',isNonDeterministic); if result then begin rest2:= TdomWideStringList.create; try while rest.Count > 0 do begin if not contentModelTest2(rest,rest2,'',isNonDeterministic) then break; rest.assign(rest2); end; finally rest2.free; end; end; end else if Frequency = '*' then begin result:= contentModelTest2(source,rest,'?',isNonDeterministic); if result then begin rest2:= TdomWideStringList.create; try while rest.Count > 0 do begin if not contentModelTest2(rest,rest2,'',isNonDeterministic) then break; rest.assign(rest2); end; finally rest2.free; end; end; end; if isNonDeterministic then result:= false; end; function TdomCMParticle.GetFrequency: wideString; begin Result:= FFrequency; end; procedure TdomCMParticle.SetFrequency(const freq: wideString); begin if not ( (freq = '') or (freq = wideString('?')) or (freq = '*') or (freq = '+') ) then raise EInvalid_Character_Err.create('Invalid character error.'); FFrequency:= freq; end; procedure TdomCMParticle.SetNodeValue(const value: wideString); begin end; // ++++++++++++++++++++++ TdomCMSequenceParticle +++++++++++++++++++++++ constructor TdomCMSequenceParticle.create(const aOwner: TdomCustomCMObject; const freq: wideString); begin inherited create(aOwner,freq); FNodeName:= '#sequence-particle'; FNodeType:= ctSequenceParticle; FAllowedChildTypes:= [ctSequenceParticle, ctChoiceParticle, ctElementParticle]; end; function TdomCMSequenceParticle.contentModelTest2(const source, rest: TdomWideStringList; const freq: wideString; var isNonDeterministic: boolean): boolean; var i: integer; source2,rest2: TdomWideStringList; ok: boolean; begin isNonDeterministic:= false; rest.Assign(source); result:= false; source2:= TdomWideStringList.create; rest2:= TdomWideStringList.create; try source2.Assign(source); ok:= false; for i:= 0 to pred(childnodes.length) do begin ok:= (childnodes.item(i) as TdomCMParticle).contentModelTest(source2,rest2,isNonDeterministic); if not ok then break; source2.Assign(rest2); end; if freq = '' then begin if ok then begin rest.assign(rest2); result:= true; end else result:= false; end else if freq = '?' then begin if ok then rest.assign(rest2); result:= true; end; finally source2.free; rest2.free; end; if isNonDeterministic then result:= false; end; procedure TdomCMSequenceParticle.writeCode(stream: TStream); var i: integer; begin if not HasChildNodes then raise ENot_Supported_Err.create('Not supported error.'); writeWideChars(stream, ['(']); for i:= 0 to childnodes.length-1 do begin if i > 0 then writeWideChars(stream, [',', ' ']); (ChildNodes.item(i) as TdomCMParticle).writeCode(stream); end; writeWideChars(stream, [')']); writeWideString(stream, Frequency); end; function TdomCMSequenceParticle.validate: boolean; begin result:= true; end; //++++++++++++++++++++++ TdomChoiceParticle ++++++++++++++++++++++++++++ constructor TdomCMChoiceParticle.create(const aOwner: TdomCustomCMObject; const freq: wideString); begin inherited create(aOwner,freq); FNodeName:= '#choice-particle'; FNodeType:= ctChoiceParticle; FAllowedChildTypes:= [ctSequenceParticle, ctChoiceParticle, ctElementParticle]; end; function TdomCMChoiceParticle.contentModelTest2(const source, rest: TdomWideStringList; const freq: wideString; var isNonDeterministic: boolean): boolean; var i: integer; rest3,rest2: TdomWideStringList; okNumber: integer; begin isNonDeterministic:= false; rest.Assign(source); result:= false; rest3:= TdomWideStringList.create; rest2:= TdomWideStringList.create; try okNumber:= 0; for i:= 0 to pred(childnodes.length) do begin if (childnodes.item(i) as TdomCMParticle).contentModelTest(source,rest2,isNonDeterministic) then begin inc(okNumber); if okNumber > 1 then begin isNonDeterministic:= true; break; end; rest3.assign(rest2); end else if isNonDeterministic then break; end; if freq = '' then begin if okNumber = 1 then begin rest.assign(rest3); result:= true; end else result:= false; end else if freq = '?' then begin if okNumber = 1 then rest.assign(rest3); result:= true; end; finally rest3.free; rest2.free; end; if isNonDeterministic then result:= false; end; procedure TdomCMChoiceParticle.writeCode(stream: TStream); var i: integer; begin if not HasChildNodes then raise ENot_Supported_Err.create('Not supported error.'); writeWideChars(stream, ['(']); for i:= 0 to childnodes.length-1 do begin if i > 0 then writeWideChars(stream, [' ', '|', ' ']); (ChildNodes.item(i) as TdomCMParticle).writeCode(stream); end; writeWideChars(stream, [')']); writeWideString(stream, Frequency); end; function TdomCMChoiceParticle.validate: boolean; begin result:= true; end; // +++++++++++++++++++ TdomCMPcdataChoiceParticle ++++++++++++++++++++++ constructor TdomCMPcdataChoiceParticle.create(const aOwner: TdomCustomCMObject; const freq: wideString); begin if freq <> '*' then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner,freq); FNodeName:= '#pcdata-choice-particle'; FNodeType:= ctPcdataChoiceParticle; FAllowedChildTypes:= [ctElementParticle]; end; function TdomCMPcdataChoiceParticle.contentModelTest(const source, rest: TdomWideStringList; var isNonDeterministic: boolean): boolean; begin raise EParserException.create('Parser exception in TdomCMParticle.contentModelTest'); end; procedure TdomCMPcdataChoiceParticle.SetFrequency(const freq: wideString); begin if freq <> '*' then raise EInvalid_Character_Err.create('Invalid character error.'); FFrequency:= freq; end; procedure TdomCMPcdataChoiceParticle.writeCode(stream: TStream); var i: integer; begin writeWideString(stream, '( #PCDATA'); for i:= 0 to childnodes.length-1 do begin writeWideChars(stream, [' ', '|', ' ']); (ChildNodes.item(i) as TdomCMParticle).writeCode(stream); end; writeWideChars(stream, [' ', ')']); writeWideString(stream, Frequency); end; function TdomCMPcdataChoiceParticle.elementDefined(const elementName: wideString): boolean; var i: integer; begin if not IsXmlName(elementName) then raise EInvalid_Character_Err.create('Invalid character error.'); result:= false; for i:= 0 to pred(childnodes.length) do begin if childnodes.item(i).nodeName = elementName then begin result:= true; exit; end; end; end; function TdomCMPcdataChoiceParticle.validate: boolean; var i: integer; particleNames: TdomWideStringList; begin result:= true; particleNames:= TdomWideStringList.create; particleNames.Sorted:= true; particleNames.Duplicates:= dupError; try for i:= 0 to pred(childnodes.length) do begin try particleNames.Add(childnodes.item(i).nodeName); except // xxx not elegant result:= false; sendErrorNotification(ET_DUPLICATE_NAME_IN_MIXED_CONTENT,childnodes.item(i)); break; end; {try ... except ...} end; {for ...} finally particleNames.free; end; end; // +++++++++++++++++++++ TdomCMElementParticle +++++++++++++++++++++++++ constructor TdomCMElementParticle.create(const aOwner: TdomCustomCMObject; const name, freq: wideString); begin if not isXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner,freq); FNodeName:= name; FNodeType:= ctElementParticle; FAllowedChildTypes:= []; end; function TdomCMElementParticle.contentModelTest2(const source, rest: TdomWideStringList; const freq: wideString; var isNonDeterministic: boolean): boolean; begin isNonDeterministic:= false; result:= false; rest.Assign(source); if freq = '' then begin if rest.Count = 0 then exit; if rest[0] = nodeName then begin rest.Delete(0); result:= true; end else result:= false; end else if freq = '?' then begin result:= true; if rest.Count = 0 then exit; if rest[0] = nodeName then rest.Delete(0); end; end; procedure TdomCMElementParticle.writeCode(stream: TStream); begin writeWideStrings(stream, [NodeName, Frequency]); end; function TdomCMElementParticle.validate: boolean; begin result:= true; end; // +++++++++++++++++++++++ TdomCMNameParticle ++++++++++++++++++++++++++ constructor TdomCMNameParticle.create(const aOwner: TdomCustomCMObject; const name: wideString); begin if not isXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FNodeName:= name; FNodeType:= ctNameParticle; FAllowedChildTypes:= []; end; procedure TdomCMNameParticle.SetNodeValue(const value: wideString); begin end; function TdomCMNameParticle.validate: boolean; begin result:= true; end; // +++++++++++++++++++++ TdomCMNmtokenParticle +++++++++++++++++++++++++ constructor TdomCMNmtokenParticle.create(const aOwner: TdomCustomCMObject; const name: wideString); begin if not isXmlNmtoken(name) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FNodeName:= name; FNodeType:= ctNmtokenParticle; FAllowedChildTypes:= []; end; procedure TdomCMNmtokenParticle.SetNodeValue(const value: wideString); begin end; function TdomCMNmtokenParticle.validate: boolean; begin result:= true; end; // ++++++++++++++++++++++++++ TdomCMAttribute ++++++++++++++++++++++++++ constructor TdomCMAttribute.create(const aOwner: TdomCustomCMObject; const elementName, attributeName, attType, defaultDecl, attValue: wideString); procedure FurtherAttrNormalization(var S: wideString); const DOUBLESPACE: wideString = #$20#$20; var dummy: wideString; nPos: integer; begin repeat nPos := Pos(DOUBLESPACE, S); if nPos > 0 then Delete(S, nPos, 1); until nPos = 0; dummy:= S; s:= XMLTruncSpace(dummy); end; const sQuote: wideString = #$0027; dQuote: wideString = '"'; var normalizedAttValue: wideString; begin if not IsXmlName(attributeName) then raise EInvalid_Character_Err.create('Invalid character error.'); if not IsXmlName(elementName) then raise EInvalid_Character_Err.create('Invalid character error.'); if not ( (attType='') or (attType='NOTATION') or IsXmlStringType(attType) or IsXmlTokenizedType(attType) ) then raise EInvalid_Character_Err.create('Invalid character error.'); if not ( (defaultDecl = '#REQUIRED') or (defaultDecl = '#IMPLIED') or (defaultDecl = '#FIXED') or (defaultDecl = '') ) then raise EInvalid_Character_Err.create('Invalid character error.'); if ((defaultDecl = '#REQUIRED') or (defaultDecl = '#IMPLIED')) and (attValue <> '') then raise EInvalid_Character_Err.create('Invalid character error.'); normalizedAttValue:= attValue; if not IsXmlStringType(attType) then FurtherAttrNormalization(normalizedAttValue); if not ( IsXMLAttValue(concat(dQuote,normalizedAttValue,dQuote)) or IsXMLAttValue(concat(sQuote,normalizedAttValue,sQuote)) ) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FAttributeName:= attributeName; FElementName:= elementName; FNodeName:= '#cm-attribute'; FNodeType:= ctAttribute; FAttributeType:= attType; FDefaultDeclaration:= defaultDecl; FNodeValue:= normalizedAttValue; FAllowedChildTypes:= []; if attType = '' then FAllowedChildTypes:= [ctNmtokenParticle]; if attType = 'NOTATION' then FAllowedChildTypes:= [ctNameParticle]; end; procedure TdomCMAttribute.setNodeValue(const value: wideString); begin end; // ++++++++++++++++++++++++++ TdomCMNotation ++++++++++++++++++++++++++ constructor TdomCMNotation.create(const aOwner: TdomCustomCMObject; const name, pubId, sysId: wideString); begin if not IsXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); if not isXmlSystemChars(sysId) then raise EInvalid_Character_Err.create('Invalid character error.'); if not isXmlPubidChars(pubId) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FNodeName:= name; FNodeValue:= ''; FPublicId:= pubId; FSystemId:= sysId; FNodeType:= ctNotation; FAllowedChildTypes:= []; end; // +++++++++++++++++++++++++++++ TdomCMEntity +++++++++++++++++++++++++++++ constructor TdomCMEntity.create(const aOwner: TdomCustomCMObject; const name, litValue: wideString); begin if not isXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FAllowedChildTypes:= []; FEncoding:= ''; // xxx Set this on create? FEntityType:= etInternal_Entity; FIsParsedEntity:= true; FIsResolved:= false; FIsUnusable:= false; FLiteralValue:= ''; FNodeName:= name; FNodeValue:= ''; FNodeType:= ctEntity; FNotationName:= ''; FPublicId:= ''; FReplacementText:= ''; FSystemId:= ''; calculateLiteralValue(litValue); // sets replacement text, too. end; constructor TdomCMEntity.createExtParsed(const aOwner: TdomCustomCMObject; const name, pubId, sysId: wideString); begin if not isXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); if not isXmlPubidChars(pubId) then raise EInvalid_Character_Err.create('Invalid character error.'); if not isXmlSystemChars(sysId) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FAllowedChildTypes:= []; FEncoding:= ''; // xxx Set this on create? FEntityType:= etExternal_Entity; FIsParsedEntity:= true; FIsResolved:= false; FIsUnusable:= false; FLiteralValue:= ''; FNodeName:= name; FNodeValue:= ''; FNodeType:= ctEntity; FNotationName:= ''; FPublicId:= pubId; FReplacementText:= ''; FSystemId:= sysId; end; constructor TdomCMEntity.createExtUnparsed(const aOwner: TdomCustomCMObject; const name, pubId, sysId, notaName: wideString); begin if not isXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); if not isXmlPubidChars(pubId) then raise EInvalid_Character_Err.create('Invalid character error.'); if not isXmlSystemChars(sysId) then raise EInvalid_Character_Err.create('Invalid character error.'); if not isXmlName(notaName) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FAllowedChildTypes:= []; FEncoding:= ''; // xxx Set this on create? FEntityType:= etExternal_Entity; FIsParsedEntity:= false; FIsResolved:= false; FIsUnusable:= false; FLiteralValue:= ''; FNodeName:= name; FNodeValue:= ''; FNodeType:= ctEntity; FNotationName:= notaName; FPublicId:= pubId; FReplacementText:= ''; FSystemId:= sysId; end; function TdomCMEntity.refersToXyz(const allowUnresolvableEntities: boolean; const previousEntities: TdomWideStringList; const whatToTest: integer): boolean; // Recursivly tests, whether the TdomCMEntity is an external entity // (whatToTest = 1), an unparsed entity (whatToTest = 2), or an unusable // (whatToTest = 3). // To just traverse all resolved entity references in order to test // for circular references, 'whatToTest' must be set to 0. const AMP: WideChar = #$26; // '&' SEMICOLON: WideChar = #$3B; // ';' var i: integer; SChar: widechar; refName,S: wideString; dereferencedEntity: TdomCMEntity; updatedEntities: TdomWideStringList; ampActive: boolean; begin case whatToTest of 0: Result:= false; 1: result:= (entityType = etExternal_Entity); 2: result:= not FIsParsedEntity; 3: result:= FIsUnusable; else raise ESyntax_Err.create('Syntax error in TdomCMEntity.refersToXyz'); end; if result then exit; S:= ReplacementText; i:= 1; ampActive:= false; refName:= ''; while i <= length(S) do begin SChar:= WideChar((PWideChar(S)+i-1)^); if ampActive then begin if SChar = SEMICOLON then begin if IsXmlName(refName) then begin if (previousEntities.indexOf(refName) = -1) then begin dereferencedEntity:= (ownerCMObject as TdomCMObject).Entities.getNamedItem(refName); if not assigned(dereferencedEntity) then begin if not allowUnresolvableEntities then if not ( (refName='lt') or (refName='gt') or (refName='amp') or (refName='apos') or (refName='quot')) then raise EConvertError.CreateFmt('&%S; cannot be resolved.',[refName]); end else begin updatedEntities:= TdomWideStringList.create; try updatedEntities.Assign(previousEntities); updatedEntities.Add(refName); Result:= dereferencedEntity.refersToXyz(allowUnresolvableEntities,updatedEntities,whatToTest); finally updatedEntities.free; end; end; end else begin if whatToTest = 0 then result:= true; // circular reference end; if result then exit; end; ampActive:= false; refName:= ''; end else refName:= concat(refName,wideString(SChar)); end else begin if SChar = AMP then ampActive:= true; end; inc(i); end; {while ...} end; procedure TdomCMEntity.calculateLiteralValue(const S: wideString); const AMP: WideChar = #$26; // '&' SEMICOLON: WideChar = #$3B; // ';' var i,j,indexpos: integer; SChar, SChar2: widechar; ref: wideString; content: TdomCustomStr; parser: TXmlToDomParser; dummyDoc: TdomDocument; begin if not isParsedEntity then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); // Calculate replacment text content:= TdomCustomStr.create; try i:= 1; while i <= length(S) do begin SChar:= WideChar((PWideChar(S)+i-1)^); if IsUtf16LowSurrogate(sChar) then raise EInvalid_Character_Err.CreateFmt('%S must not start with a UTF-16 low surrogate.',[S]); if IsUtf16HighSurrogate(SChar) then begin if i+1 > length(s) then raise EInvalid_Character_Err.CreateFmt('%S must not end with a UTF-16 high surrogate.',[S]); inc(i); SChar:= WideChar((PWideChar(S)+i-1)^); if not IsUtf16LowSurrogate(SChar) then raise EInvalid_Character_Err.CreateFmt('%S contains an UTF-16 high surrogate without its corresponding low surrogate.',[S]); end; if not IsXmlChar(sChar) then raise EInvalid_Character_Err.CreateFmt('%S contains an invalid character.',[S]); if (entityType = etInternal_Entity) and (SChar = AMP) then begin // Reference? indexpos:= -1; for j:= i+1 to length(S) do begin SChar2:= WideChar((PWideChar(S)+j-1)^); if SChar2 = SEMICOLON then begin indexpos:= j; break; end; end; if indexpos = -1 then raise EInvalid_Character_Err.CreateFmt('%S contains an ''&'' without a '';''.',[S]); ref:= copy(S,i,j-i+1); if not (IsXmlEntityRef(ref) or IsXmlCharRef(ref)) then raise EInvalid_Character_Err.CreateFmt('%S contains an invalid reference.',[S]); if (entityType = etInternal_Entity) and isXmlCharRef(ref) then content.addWideString(XmlCharRefToStr(ref)) else content.addWideString(ref); i:= j; end else content.addWideChar(SChar); inc(i); end; {while ...} FReplacementText:= content.value; FLiteralValue:= S; FIsResolved:= true; finally content.free; end; // IsUnusable? if FReplacementText <> '' then begin parser:= TXmlToDomParser.create(nil); try parser.domImpl:= OwnerCMObject.domImplementation; dummyDoc:= OwnerCMObject.domImplementation.createDocument('dummy',nil); try parser.docWideStringToDom(FReplacementText,'','',dummyDoc.documentElement); except FIsUnusable:= true; end; {try ...} OwnerCMObject.domImplementation.FreeDocument(dummyDoc); finally parser.free; end; {try ...} end; {if ...} end; procedure TdomCMEntity.setNodeValue(const value: wideString); begin end; function TdomCMEntity.getIsUnusable: boolean; begin if isParsedEntity and (FEntityType = etExternal_Entity) then calculateLiteralValue(literalValue); result:= refersToUnusableEntity(true); end; function TdomCMEntity.getLiteralValue: wideString; begin if not isParsedEntity then raise EConvertError.CreateFmt('&%S; is an unparsed entity.',[Nodename]); if not resolve then raise EConvertError.create('Entity cannot be resolved.'); result:= FLiteralValue; end; function TdomCMEntity.getNormalizedValue: wideString; const TAB: WideChar = #$9; // Horizontal Tabulation LF: WideChar = #$A; // Line Feed CR: WideChar = #$D; // Carriage Return SPACE: WideChar = #$20; // ' ' AMP: WideChar = #$26; // '&' SEMICOLON: WideChar = #$3B; // ';' var i,j: integer; SChar, SChar2: widechar; ref,derefText,S: wideString; content: TdomCustomStr; dereferencedEntity: TdomCMEntity; begin if not isParsedEntity then raise EConvertError.CreateFmt('&%S; is an unparsed entity.',[Nodename]); if entityType = etExternal_Entity then raise EConvertError.CreateFmt('&%S; is an external entity.',[Nodename]); result:= ''; S:= ReplacementText; content:= TdomCustomStr.create; try i:= 1; while i <= length(S) do begin SChar:= WideChar((PWideChar(S)+i-1)^); if (SChar = TAB) or (SChar = LF) or (SChar = CR) // White space? then content.addWideChar(SPACE) else if SChar = AMP then begin // Reference? for j:= i+1 to length(S) do begin SChar2:= WideChar((PWideChar(S)+j-1)^); if SChar2 = SEMICOLON then break; // End of Reference? end; // Test for indexpos = -1 is not necessary here, because of the previous test in calculateReplacementText(). ref:= copy(S,i,j-i+1); if IsXmlEntityRef(ref) then begin dereferencedEntity:= (ownerCMObject as TdomCMObject).Entities.getNamedItem(copy(ref,2,length(ref)-2)); if not assigned(dereferencedEntity) then raise EConvertError.CreateFmt('&%S; refers to an undeclared entity.',[Nodename]); if dereferencedEntity.entityType = etExternal_Entity then raise EConvertError.CreateFmt('&%S; refers to an external entity.',[Nodename]); if dereferencedEntity = self then raise EConvertError.CreateFmt('&%S; refers to itself.',[Nodename]); derefText:= dereferencedEntity.normalizedValue; // Whether dereferencedEntity is assigned was tested in 'refersToUnparsedEntity' content.addWideString(derefText); end else // Test for IsXmlCharRef is not necessary here, because of the previous test in calculateReplacementText(). content.addWideString(XmlCharRefToStr(ref)); i:= j; end else content.addWideChar(SChar); inc(i); end; {while ...} Result:= content.value; finally content.free; end; end; function TdomCMEntity.getReplacementText: wideString; begin if not isParsedEntity then raise EConvertError.CreateFmt('&%S; is an unparsed entity.',[Nodename]); if not resolve then raise EConvertError.create('Invalid entity reference error.'); result:= FReplacementText; end; function TdomCMEntity.refersToItself(const allowUnresolvableEntities: boolean): boolean; // This procedure just traverses through all entity references in // order to test for circular references. If a circular reference is // found, the called subroutine 'refersToXyz' raises an EConvertError. var previousEntities: TdomWideStringList; begin result:= false; previousEntities:= TdomWideStringList.create; try try result:= refersToXyz(allowUnresolvableEntities,previousEntities,0); except raise EConvertError.create('Invalid entity reference error.'); end; finally previousEntities.free; end; end; function TdomCMEntity.refersToExternalEntity(const allowUnresolvableEntities: boolean): boolean; // This function returns 'true', if a node refers directly or // indirectly to an external Entity. var previousEntities: TdomWideStringList; begin result:= false; previousEntities:= TdomWideStringList.create; try try result:= refersToXyz(allowUnresolvableEntities,previousEntities,1); except raise EConvertError.create('Invalid entity reference error.'); end; finally previousEntities.free; end; end; function TdomCMEntity.refersToUnparsedEntity(const allowUnresolvableEntities: boolean): boolean; // This function returns 'true', if a node refers directly or // indirectly to an unparsed Entity. var previousEntities: TdomWideStringList; begin result:= false; previousEntities:= TdomWideStringList.create; try try result:= refersToXyz(allowUnresolvableEntities,previousEntities,2); except raise EConvertError.create('Invalid entity reference error.'); end; finally previousEntities.free; end; end; function TdomCMEntity.refersToUnusableEntity(const allowUnresolvableEntities: boolean): boolean; // This function returns 'true', if a node refers directly or // indirectly to an Entity marked as unusable (such as declared // e.g. by ), or if the node itself is unusable. var previousEntities: TdomWideStringList; begin result:= false; previousEntities:= TdomWideStringList.create; try try result:= refersToXyz(allowUnresolvableEntities,previousEntities,3); except raise EConvertError.create('Invalid entity reference error.'); end; finally previousEntities.free; end; end; function TdomCMEntity.resolve: boolean; var action: TXmlParserAction; litValue,PId,SId: wideString; inputSrc: TXmlInputSource; stream: TStream; begin // xxx resolvement of unparsed entities missing! if not isResolved then begin result:= false; if isParsedEntity and (FEntityType = etExternal_Entity) then begin stream:= nil; PId:= publicId; SId:= systemId; if assigned(ownerCMObject) then if assigned(ownerCMObject.domImplementation) then ownerCMObject.domImplementation.doExternalParsedEntity(ownerCMObject.systemId,PId,SId,stream,action); if (action <> paFail) and assigned(stream) then begin try // convert external entity value to UTF-16BE: InputSrc:= TXmlInputSource.create(stream,'','',1); try if InputSrc.hasMalformedDecl or not ( InputSrc.declType in [ DT_TEXT_DECLARATION, DT_XML_OR_TEXT_DECLARATION, DT_UNSPECIFIED] ) then result:= false else begin litValue:= InputSrc.streamAsWideString; calculateLiteralValue(litValue); result:= true; end; {if ... else ...} finally InputSrc.free; end; {try} finally stream.free; end; end; {if ...} end; {if ...} end else result:= true; end; // ++++++++++++++++++++++++ TdomCustomCMEntDecl ++++++++++++++++++++++++++ constructor TdomCustomCMEntDecl.create(const aOwner: TdomCustomCMObject; const name, litValue: wideString); begin if not isXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FAllowedChildTypes:= []; FEntityType:= etInternal_Entity; FNodeName:= name; FNodeValue:= litValue; FPublicId:= ''; FSystemId:= ''; end; constructor TdomCustomCMEntDecl.createExtParsed(const aOwner: TdomCustomCMObject; const name, pubId, sysId: wideString); begin if not isXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); if not isXmlSystemChars(sysId) then raise EInvalid_Character_Err.create('Invalid character error.'); if not isXmlPubidChars(pubId) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FNodeName:= name; FPublicId:= pubId; FSystemId:= sysId; FEntityType:= etExternal_Entity end; function TdomCustomCMEntDecl.insertBefore(const newChild, refChild: TdomCMNode): TdomCMNode; begin if (publicId <> '') or (systemId <> '') then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); Result:= inherited insertBefore(newChild,refChild); end; function TdomCustomCMEntDecl.replaceChild(const newChild, oldChild: TdomCMNode): TdomCMNode; begin if (publicId <> '') or (systemId <> '') then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); Result:= inherited replaceChild(newChild,oldChild); end; function TdomCustomCMEntDecl.appendChild(const newChild: TdomCMNode): TdomCMNode; begin if (publicId <> '') or (systemId <> '') then raise ENo_Modification_Allowed_Err.create('No modification allowed error.'); Result:= inherited appendChild(newChild); end; function TdomCustomCMEntDecl.GetPublicId: wideString; begin Result:= FPublicId; end; function TdomCustomCMEntDecl.GetSystemId: wideString; begin Result:= FSystemId; end; function TdomCustomCMEntDecl.GetEntityType: TdomEntityType; begin result:= FEntityType; end; // +++++++++++++++++++++ TdomCMEntityDeclaration +++++++++++++++++++++++ constructor TdomCMEntityDeclaration.create(const aOwner: TdomCustomCMObject; const name, litValue: wideString); begin inherited; FIsParsedEntity:= true; FIsReadonly:= true; FNodeType:= ctEntityDeclaration; FNotationName:= ''; end; constructor TdomCMEntityDeclaration.createExtParsed(const aOwner: TdomCustomCMObject; const name, pubId, sysId: wideString); begin inherited; FEntityType:= etExternal_Entity; FIsParsedEntity:= true; FIsReadonly:= true; FNodeType:= ctEntityDeclaration; FNotationName:= ''; end; constructor TdomCMEntityDeclaration.createExtUnparsed(const aOwner: TdomCustomCMObject; const name, pubId, sysId, notaName: wideString); begin if not IsXMLName(notaName) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited createExtParsed(aOwner,name,pubId,sysId); FEntityType:= etExternal_Entity; FIsParsedEntity:= false; FIsReadonly:= true; FNodeType:= ctEntityDeclaration; FNotationName:= notaName; end; function TdomCMEntityDeclaration.validate: boolean; begin result:= true; end; // ++++++++++++++++ TdomCMParameterEntityDeclaration +++++++++++++++++++ constructor TdomCMParameterEntityDeclaration.create(const aOwner: TdomCustomCMObject; const name, litValue: wideString); begin inherited; FIsReadonly:= true; FNodeType:= ctParameterEntityDeclaration; end; constructor TdomCMParameterEntityDeclaration.createExtParsed(const aOwner: TdomCustomCMObject; const name, pubId, sysId: wideString); begin inherited; FEntityType:= etExternal_Entity; FIsReadonly:= true; FNodeType:= ctParameterEntityDeclaration; end; function TdomCMParameterEntityDeclaration.validate: boolean; begin result:= true; end; // +++++++++++++++++++ TdomCMParameterEntityReference +++++++++++++++++++ constructor TdomCMParameterEntityReference.create(const aOwner: TdomCustomCMObject; const name: wideString); begin if not IsXmlName(name) then raise EInvalid_Character_Err.create('Invalid character error.'); inherited create(aOwner); FNodeName:= name; FNodeValue:= ''; FNodeType:= ctParameterEntityReference; FAllowedChildTypes:= []; end; procedure TdomCMParameterEntityReference.SetNodeValue(const value: wideString); begin end; function TdomCMParameterEntityReference.validate: boolean; var i: integer; begin result:= true; for i:= 0 to pred(childnodes.length) do begin // xxx necessary? if not childnodes.item(i).validate then begin result:= false; exit; end; end; end; // ++++++++++++++++++++++++ TdomCMFragment +++++++++++++++++++++++++++++ constructor TdomCMFragment.create(const aOwner: TdomCustomCMObject); begin inherited create(aOwner); FNodeName:= '#cm-fragment'; FNodeValue:= ''; FNodeType:= ctFragment; end; procedure TdomCMFragment.SetNodeValue(const value: wideString); begin // Do nothing. end; // +++++++++++++++++++++++++++ TXmlSourceCode ++++++++++++++++++++++++++ procedure TXmlSourceCode.calculatePieceOffset(const startItem: integer); var os, i: integer; begin if (startItem < count) and (startItem >= 0) then begin if startItem = 0 then os:= 0 else begin if not assigned(Items[startItem-1]) then begin pack; exit; end else with TXmlSourceCodePiece(Items[startItem-1]) do os:= FOffset + length(FText); end; for i:= startItem to count -1 do if not assigned(Items[i]) then begin pack; exit; end else with TXmlSourceCodePiece(Items[i]) do begin FOffset:= os; os:= os + length(FText); end; end; {if ...} end; function TXmlSourceCode.getNameOfFirstTag: wideString; var i,j,k: integer; begin result:= ''; for i:= 0 to count -1 do if assigned(Items[i]) then with TXmlSourceCodePiece(Items[i]) do if (pieceType = xmlStartTag) or (pieceType = xmlEmptyElementTag) then begin if pieceType = xmlStartTag then k:= length(text)-1 else k:= length(text)-2; j:= 1; while j < k do begin inc(j); if IsXmlWhiteSpace(text[j]) then break; Result:= concat(Result,wideString(WideChar(text[j]))); end; exit; end; end; function TXmlSourceCode.Add(Item: pointer): Integer; begin if assigned(Item) then begin if not assigned(TXmlSourceCodePiece(Item).FOwner) then TXmlSourceCodePiece(Item).FOwner:= self else Error('Inuse source code piece error.',-1); end else Error('Item not assigned error.',-1); Result:= inherited Add(Item); calculatePieceOffset(Result); end; procedure TXmlSourceCode.Clear; var i: integer; begin for i:= 0 to count -1 do if assigned(Items[i]) then with TXmlSourceCodePiece(Items[i]) do begin FOffset:= 0; FOwner:= nil; end; inherited clear; end; procedure TXmlSourceCode.ClearAndFree; var i: integer; begin for i:= 0 to count -1 do if assigned(Items[i]) then TXmlSourceCodePiece(Items[i]).free; inherited clear; end; procedure TXmlSourceCode.Delete(Index: Integer); begin if assigned(Items[index]) then with TXmlSourceCodePiece(Items[index]) do begin FOffset:= 0; FOwner:= nil; end; inherited Delete(index); calculatePieceOffset(Index); end; procedure TXmlSourceCode.Exchange(Index1, Index2: Integer); var nr: integer; begin nr:= MinIntValue([Index1,Index2]); inherited Exchange(Index1,Index2); calculatePieceOffset(nr); end; function TXmlSourceCode.GetPieceAtPos(pos: integer): TXmlSourceCodePiece; var i: integer; begin // xxx This search routine is not optimized. Result:= nil; if pos < 1 then exit; for i:= 0 to count -1 do if not assigned(Items[i]) then begin pack; Result:= getPieceAtPos(pos); end else with TXmlSourceCodePiece(Items[i]) do begin if (FOffset + length(FText)) >= pos then begin Result:= TXmlSourceCodePiece(Items[i]); exit; end; end; end; procedure TXmlSourceCode.Insert(Index: Integer; Item: pointer); begin if assigned(Item) then begin if not assigned(TXmlSourceCodePiece(Item).FOwner) then TXmlSourceCodePiece(Item).FOwner:= self else Error('Inuse source code piece error.',-1); end else Error('Item not assigned error.',-1); inherited Insert(Index,item); calculatePieceOffset(index); end; procedure TXmlSourceCode.Move(CurIndex, NewIndex: Integer); var nr: integer; begin nr:= MinIntValue([CurIndex,NewIndex]); inherited Move(CurIndex, NewIndex); calculatePieceOffset(nr); end; procedure TXmlSourceCode.Pack; begin inherited pack; calculatePieceOffset(0); end; function TXmlSourceCode.Remove(Item: pointer): Integer; var nr: integer; begin nr:= IndexOf(Item); result:= inherited Remove(Item); if assigned(Items[nr]) then with TXmlSourceCodePiece(Item) do begin FOffset:= 0; FOwner:= nil; end; calculatePieceOffset(nr); end; procedure TXmlSourceCode.Sort(Compare: TListSortCompare); begin inherited Sort(Compare); calculatePieceOffset(0); end; // ++++++++++++++++++++++++ TXmlSourceCodePiece ++++++++++++++++++++++++ constructor TXmlSourceCodePiece.create(const pt: TdomPieceType); begin FPieceType:= pt; Ftext:= ''; FOffset:= 0; FOwner:= nil; end; // ++++++++++++++++++++++++++ TXmlInputSource ++++++++++++++++++++++++++ constructor TXmlInputSource.create(const stream: TStream; const publicId, systemId: wideString; const tabWidthValue: integer); var line, column: integer; begin if not assigned(stream) then raise EStreamError.create('Stream not specified.'); inherited create; FLastUcs4:= 0; FLastCharWasCR:= false; FStream:= stream; FPublicId:= publicId; FSystemId:= systemId; FHasMalformedDecl:= not evaluateXmlOrTextDecl( tabWidthValue, FDeclType, FEncoding, FVersionNumber, FEncodingName, FStandalone, line, column ); FStartPosition:= FStream.Position; FLocator:= TdomInputSourceLocator.create(self,line,column,line,column,tabWidthValue); end; destructor TXmlInputSource.destroy; begin FLocator.free; inherited destroy; end; function TXmlInputSource.evaluateXmlOrTextDecl(const tabWidthValue: integer; out declType: TdomXMLDeclType; out encodingType: TdomEncodingType; out versionInfo, encName: wideString; out standalone: TdomStandalone; out lineOffset, columnOffset: integer): boolean; var BOM_Offset: integer; // Byte order mark offset ch: wideChar; encType: TdomEncodingType; loc: TdomInputSourceLocator; qm: wideChar; str1: wideChar; begin result:= true; declType:= DT_UNKNOWN; encName:= ''; versionInfo:= ''; standalone:= STANDALONE_UNSPECIFIED; lineOffset:= 0; columnOffset:= 0; try FStream.ReadBuffer(str1,2); case ord(str1) of $feff: begin encodingType:= etUTF16BE; BOM_Offset:= 2; end; $fffe: begin encodingType:= etUTF16LE; BOM_Offset:= 2; end; else encodingType:= etUTF8; BOM_Offset:= 0; FStream.seek(0,soFromBeginning); end; except on EReadError do begin encodingType:= etUTF8; FStream.seek(0,soFromBeginning); declType:= DT_UNSPECIFIED; exit; end; end; {try ...} try loc:= TdomInputSourceLocator.create(self,1,1,1,1,tabWidthValue); try if getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $003c ) // '<' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $003f ) // '?' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $0078 ) // 'x' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $006d ) // 'm' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $006c ) // 'l' then begin // Does the stream start with ' qm then begin // Is the first quotation mark of the same type as the second? result:= false; exit; end; if not getNextWideChar2(ch,encodingType,loc) then begin result:= false; exit; end; // Skip Whitespace: while IsXmlWhiteSpace(ch) do if not getNextWideChar2(ch,encodingType,loc) then begin result:= false; exit; end; end else begin result:= false; exit; end; {if ... else ...} end else declType:= DT_TEXT_DECLARATION; // EncodingDecl: if ( ord(ch) = $0065 ) then begin // 'e' if getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $006e ) // 'n' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $0063 ) // 'c' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $006f ) // 'o' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $0064 ) // 'd' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $0069 ) // 'i' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $006e ) // 'n' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $0067 ) // 'g' then begin if not getNextWideChar2(ch,encodingType,loc) then begin result:= false; exit; end; // Skip Whitespace: while IsXmlWhiteSpace(ch) do if not getNextWideChar2(ch,encodingType,loc) then begin result:= false; exit; end; if not ( ord(ch) = $003d ) then begin // '=' result:= false; exit; end; if not getNextWideChar2(ch,encodingType,loc) then begin result:= false; exit; end; // Skip Whitespace: while IsXmlWhiteSpace(ch) do if not getNextWideChar2(ch,encodingType,loc) then begin result:= false; exit; end; if not ( ( ord(ch) = $0022 ) or ( ord(ch) = $0027 ) ) then begin // '"' or ''' result:= false; exit; end; qm:= ch; // Get encoding name value: if not getNextWideChar2(ch,encodingType,loc) then begin result:= false; exit; end; if isXmlEncNameLeadingChar(ch) then begin encName:= ch; end else begin result:= false; exit; end; if not getNextWideChar2(ch,encodingType,loc) then begin result:= false; exit; end; while isXmlEncNameFollowingChar(ch) do begin encName:= concat(encName,wideString(ch)); if not getNextWideChar2(ch,encodingType,loc) then begin result:= false; exit; end; end; if ch <> qm then begin // Is the first quotation mark of the same type as the second? result:= false; exit; end; if not getNextWideChar2(ch,encodingType,loc) then begin result:= false; exit; end; // Skip Whitespace: while IsXmlWhiteSpace(ch) do if not getNextWideChar2(ch,encodingType,loc) then begin result:= false; exit; end; end else begin result:= false; exit; end; {if ... else ...} end else begin if declType = DT_TEXT_DECLARATION then begin result:= false; exit; end else declType:= DT_XML_DECLARATION; end; {if ... else ...} // SDDecl: if ( ord(ch) = $0073 ) then begin // 's' if getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $0074 ) // 't' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $0061 ) // 'a' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $006e ) // 'n' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $0064 ) // 'd' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $0061 ) // 'a' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $006c ) // 'l' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $006f ) // 'o' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $006e ) // 'n' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $0065 ) // 'e' then begin if declType = DT_TEXT_DECLARATION then begin result:= false; exit; end else declType:= DT_XML_DECLARATION; if not getNextWideChar2(ch,encodingType,loc) then begin result:= false; exit; end; // Skip Whitespace: while IsXmlWhiteSpace(ch) do if not getNextWideChar2(ch,encodingType,loc) then begin result:= false; exit; end; if not ( ord(ch) = $003d ) then begin // '=' result:= false; exit; end; if not getNextWideChar2(ch,encodingType,loc) then begin result:= false; exit; end; // Skip Whitespace: while IsXmlWhiteSpace(ch) do if not getNextWideChar2(ch,encodingType,loc) then begin result:= false; exit; end; if not ( ( ord(ch) = $0022 ) or ( ord(ch) = $0027 ) ) then begin // '"' or ''' result:= false; exit; end; qm:= ch; // Get standalone document declaration value: if not getNextWideChar2(ch,encodingType,loc) then begin result:= false; exit; end; case ord(ch) of $0079: begin // 'y' if getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $0065 ) // 'e' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $0073 ) // 's' and getNextWideChar2(ch,encodingType,loc) then begin standalone:= STANDALONE_YES; end else begin result:= false; exit; end; end; $006e: begin // 'n' if getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $006f ) // 'o' and getNextWideChar2(ch,encodingType,loc) then begin standalone:= STANDALONE_NO; end else begin result:= false; exit; end; end; else result:= false; exit; end; {case ...} if ch <> qm then begin // Is the first quotation mark of the same type as the second? result:= false; exit; end; if not getNextWideChar2(ch,encodingType,loc) then begin result:= false; exit; end; // Skip Whitespace: while IsXmlWhiteSpace(ch) do if not getNextWideChar2(ch,encodingType,loc) then begin result:= false; exit; end; end else begin result:= false; exit; end; {if ... else ...} end; {if ...} // '?>': if ( ord(ch) = $003f ) // '?' and getNextWideChar2(ch,encodingType,loc) and ( ord(ch) = $003e ) // '>' then begin // Calculate encodingType: encType:= StrToEncoding(UTF16To7BitASCIIStr(encName)); if encType <> etUnknown then encodingType:= encType; end else result:= false; end else result:= false; end else begin declType:= DT_UNSPECIFIED; FStream.seek(BOM_Offset,soFromBeginning); // Set the stream position directly behind the byte order mark. end; finally lineOffset:= loc.lineNumber; columnOffset:= loc.columnNumber; loc.free; end; {try ...} except result:= false; FStream.seek(BOM_Offset,soFromBeginning); end; {try ...} end; function TXmlInputSource.getNextWideChar2(var dest: wideChar; const enc: TdomEncodingType; const locator: TdomInputSourceLocator): boolean; const CR: WideChar = #13; LF: WideChar = #10; MaxCode: array[1..6] of integer = ($7F,$7FF,$FFFF,$1FFFFF,$3FFFFFF,$7FFFFFFF); var str0, first: Char; CharSize, ucs4, mask: integer; begin if stream.Position < stream.size then result:= true else begin result:= false; exit; end; case Enc of etUTF8: begin if FLastUcs4>=$10000 then begin // Output low surrogate dest:=Utf16LowSurrogate(FLastUcs4); FLastUcs4:= 0; end else begin stream.ReadBuffer(str0,1); if ord(str0)>=$80 then // UTF-8 sequence begin CharSize:=1; first:=str0; mask:=$40; ucs4:=ord(str0); if (ord(str0) and $C0<>$C0) then raise EConvertError.CreateFmt('Invalid UTF-8 sequence at position %d',[stream.Position-1]); while (mask and ord(first)<>0) do begin // read next character of stream if stream.Position=stream.size then raise EConvertError.CreateFmt('Aborted UTF-8 sequence at position %d',[stream.Position]); stream.ReadBuffer(str0,1); if (ord(str0) and $C0<>$80) then raise EConvertError.CreateFmt('Invalid UTF-8 sequence at position %d',[stream.Position-1]); ucs4:=(ucs4 shl 6) or (ord(str0) and $3F); // add bits to result Inc(CharSize); // increase sequence length mask:=mask shr 1; // adjust mask end; if (CharSize>6) then // no 0 bit in sequence header 'first' raise EConvertError.CreateFmt('Invalid UTF-8 sequence at position %d',[stream.Position-1]); ucs4:=ucs4 and MaxCode[CharSize]; // dispose of header bits // check for invalid sequence as suggested by RFC2279 if ((CharSize>1) and (ucs4<=MaxCode[CharSize-1])) then raise EConvertError.CreateFmt('Invalid UTF-8 encoding at position %d',[stream.Position-1]); if (ucs4>=$10000) then begin // Buffer storage of the ucs4 value for output of the // low surrogate at the next function call FLastUcs4:= ucs4; // Output high surrogate dest:=Utf16HighSurrogate(ucs4); end else dest:= WideChar(ord(ucs4)); end else dest:= WideChar(ord(str0)); end; {if FLastUcs4 ... else ...} end; etUTF16BE: begin stream.ReadBuffer(dest,2); end; etUTF16LE: begin stream.ReadBuffer(dest,2); dest:= wideChar(Swap(ord(dest))); end; else stream.ReadBuffer(str0,1); dest:= SingleByteEncodingToUTF16Char(str0,Enc); end; {case ...} // normalize CRLF or a single CR to LF: if (dest = LF) and FLastCharWasCR then begin FLastCharWasCR:= false; result:= getNextWideChar2(dest,enc,locator); end else begin if dest = CR then begin FLastCharWasCR:= true; dest:= LF; end else FLastCharWasCR:= false; if assigned(locator) then locator.evaluate(dest); end; end; function TXmlInputSource.getNextWideChar(var dest: wideChar): boolean; begin try result:= getNextWideChar2(dest,FEncoding,FLocator); except on EConvertError do begin result:= true; dest:= #0; // #0 is not a legal XML character. So it is suitable // to indicate a malformed character in the source. if assigned(locator) then locator.evaluate(#0); end; end; end; function TXmlInputSource.getStreamAsWideString: wideString; var oldPosition: longint; oldFLastUcs4: integer; oldFLastCharWasCR: boolean; content: TdomCustomStr; str1: WideChar; begin try oldPosition:= FStream.Position; oldFLastUcs4:= FLastUcs4; oldFLastCharWasCR:= FLastCharWasCR; content:= TdomCustomStr.create; try FStream.seek(FStartPosition,soFromBeginning); while getNextWideChar2(str1,FEncoding,nil) do begin content.addWideChar(str1) end; result:= content.value; finally content.free; FLastUcs4:= oldFLastUcs4; FLastCharWasCR:= oldFLastCharWasCR; FStream.seek(oldPosition,soFromBeginning); end; except raise EConvertError.create('Invalid character code error.'); end; end; // ++++++++++++++++++++++++++ TdomError ++++++++++++++++++++++++++ constructor TdomError.create(const errorType: TXmlErrorType; const startLine, startColumn, endLine, endColumn, offs: integer; const uriStr: wideString; const rCMNode: TdomCMNode; const rNode: TdomNode; const code: wideString); begin inherited create; FLanguage:= iso639_en; FSupportedLanguages:= [ iso639_de, // German iso639_en, // English iso639_es, // Spanish iso639_fr, // French iso639_it, // Italian iso639_nl, // Dutch iso639_pl, // Polish iso639_pt // Portuguese ]; FRelatedException:= errorType; FCode:= Code; FLocation:= TdomLocator.create(startLine,startColumn,endLine,endColumn,offs,UriStr,rCMNode,rNode); end; constructor TdomError.createFromLocator(const errorType: TXmlErrorType; const location: TdomLocator; const code: wideString); begin if assigned(location) then with location do self.create(errorType, startLineNumber, startColumnNumber, lineNumber, columnNumber, offset, uri, relatedCMNode, relatedNode, code) else create(errorType,0,0,0,0,-1,'',nil,nil,code); end; destructor TdomError.destroy; begin FLocation.free; inherited; end; function TdomError.getSeverity: TdomSeverity; begin if FRelatedException in ET_FATAL_ERRORS then result:= DOM_SEVERITY_FATAL_ERROR else if FRelatedException in ET_ERRORS then result:= DOM_SEVERITY_ERROR else result:= DOM_SEVERITY_WARNING; end; function TdomError.getDutchErrorStr: wideString; // - This function was provided by Erik van der Poll, // Incore Automatisering b.v., Amsterdam - var ErrorTypeStr,DocStr,ErrorStr1,ErrorStr2: string; begin case severity of DOM_SEVERITY_FATAL_ERROR: ErrorTypeStr:='FATALE FOUT '; DOM_SEVERITY_ERROR: ErrorTypeStr:='FOUT '; DOM_SEVERITY_WARNING: ErrorTypeStr:='WAARSCHUWING: '; end; with FLocation do begin DocStr:= concat('in document ',uri,' '); if lineNumber = -1 then ErrorStr1:= '' else if startLineNumber = lineNumber then begin if startColumnNumber = columnNumber then FmtStr(ErrorStr1,'in regel %d, positie %d',[lineNumber,columnNumber]) else FmtStr(ErrorStr1,'in regel %d, tussen positie %d en %d',[lineNumber,startColumnNumber,columnNumber]); end else begin FmtStr(ErrorStr1,'tussen regel %d, positie %d en regel %d, positie %d',[startLineNumber,startColumnNumber,lineNumber,columnNumber]); end; end; case FRelatedException of ET_INVALID_ELEMENT_NAME: ErrorStr2:= 'Onjuiste element naam'; ET_DOUBLE_ROOT_ELEMENT: ErrorStr2:= 'Dubbel begin element'; ET_DOUBLE_DOCTYPE: ErrorStr2:= 'Dubbele document type declaratie (DTD)'; ET_INVALID_ATTRIBUTE_NAME: ErrorStr2:= 'Onjuiste attribuut name'; ET_INVALID_ATTRIBUTE_VALUE: ErrorStr2:= 'Onjuiste attribuut waarde'; ET_DOUBLE_ATTRIBUTE_NAME: ErrorStr2:= 'Dubbele attribuut name in een element'; ET_INVALID_ENTITY_NAME: ErrorStr2:= 'Onjuiste entiteit naam'; ET_INVALID_PROCESSING_INSTRUCTION: ErrorStr2:= 'Onjuiste verwerkings code'; ET_INVALID_XML_DECL: ErrorStr2:= 'Onuiste XML declaratie'; ET_INVALID_CHARREF: ErrorStr2:= 'Onjuiste karakter referentie'; ET_MISSING_QUOTATION_MARK: ErrorStr2:= 'Aanhalingstekens ontbreken'; ET_MISSING_EQUALITY_SIGN: ErrorStr2:= 'Is-teken ontbreekt'; ET_DOUBLE_EQUALITY_SIGN: ErrorStr2:= 'Dubbel is-teken'; ET_MISSING_WHITE_SPACE: ErrorStr2:= 'Ontbrekende spaties'; ET_MISSING_START_TAG: ErrorStr2:= 'Eind-tag zonder begin-tag'; ET_MISSING_END_TAG: ErrorStr2:= 'Eind-tag ontbreekt'; ET_INVALID_CHARACTER: ErrorStr2:= 'Onjuist karakter'; ET_NOT_IN_ROOT: ErrorStr2:= 'Tekst buiten het begin element'; ET_INVALID_DOCTYPE: ErrorStr2:= 'Onjuiste documenttype declaratie'; ET_WRONG_ORDER: ErrorStr2:= 'Volgorde fout'; ET_UNKNOWN_DECL_TYPE: ErrorStr2:= 'Onbekend declaratie type'; ET_INVALID_ENTITY_DECL: ErrorStr2:= 'Onjuiste entiteits declaratie'; ET_INVALID_ELEMENT_DECL: ErrorStr2:= 'Onjuiste element declaratie'; ET_INVALID_ATTRIBUTE_DECL: ErrorStr2:= 'Onjuiste attribuut declaratie'; ET_INVALID_NOTATION_DECL: ErrorStr2:= 'Onjuiste notatie declaratie'; ET_INVALID_CONDITIONAL_SECTION: ErrorStr2:= 'Onjuiste conditionele sectie'; ET_INVALID_TEXT_DECL: ErrorStr2:= 'Onjuiste tekst declaratie'; ET_LT_IN_ATTRIBUTE_VALUE: ErrorStr2:= '''<'' in de vervangingstekst van een attribuut waarde'; ET_ATTRIBUTE_VALUE_REFERS_TO_EXTERNAL_ENTITY: ErrorStr2:= 'Attribuut waarde verwijst naar externe entiteit'; ET_RECURSIVE_REFERENCE: ErrorStr2:= 'ET_RECURSIVE_REFERENCE'; ET_REFERENCE_TO_UNPARSED_ENTITY: ErrorStr2:= 'Referentie naar een niet ingelezen entiteit'; ET_NO_PROPER_MARKUP_REFERENCED: ErrorStr2:= 'Referentie naar een entiteit zonder juiste opmaak'; ET_INVALID_COMMENT: ErrorStr2:= 'Fout in commentaar'; ET_INVALID_CDATA_SECTION: ErrorStr2:= 'Onjuiste CDATA sectie'; ET_INVALID_SYSTEM_LITERAL: ErrorStr2:= 'Onjuiste systeem tekst'; ET_INVALID_PUBID_LITERAL: ErrorStr2:= 'Onjuiste publieke tekst'; ET_INVALID_QUALIFIED_NAME: ErrorStr2:= 'ET_INVALID_QUALIFIED_NAME'; ET_INVALID_PREFIX: ErrorStr2:= 'ET_INVALID_PREFIX'; ET_INVALID_NAMESPACE_URI: ErrorStr2:= 'ET_INVALID_NAMESPACE_URI'; ET_NAMESPACE_URI_NOT_FOUND: ErrorStr2:= 'ET_NAMESPACE_URI_NOT_FOUND'; ET_WRONG_PREFIX_MAPPING_NESTING: ErrorStr2:= 'ET_WRONG_PREFIX_MAPPING_NESTING'; ET_ENCODING_NOT_SUPPORTED: ErrorStr2:= 'ET_ENCODING_NOT_SUPPORTED'; ET_DOUBLE_ATTDEF: ErrorStr2:= 'Dubbele attribuut definitie'; ET_DOUBLE_ENTITY_DECL: ErrorStr2:= 'Dubbele entiteit declaratie'; ET_DOUBLE_PARAMETER_ENTITY_DECL: ErrorStr2:= 'Dubbele parameter entiteit declaratie'; ET_UNUSABLE_ENTITY_DECL: ErrorStr2:= 'Onbruikbare entiteit gedefinieerd'; ET_ENTITY_DECL_NOT_FOUND: ErrorStr2:= 'Ontbrekende entiteit declaratie'; ET_DUPLICATE_ELEMENT_TYPE_DECL: ErrorStr2:= 'Dubbele element type declaratie'; ET_DUPLICATE_NAME_IN_MIXED_CONTENT: ErrorStr2:= 'Naam komt meer keren voor in gemengde inhoud'; ET_DUPLICATE_ID_ON_ELEMENT_TYPE: ErrorStr2:= 'Dubbel ID attribuut binnen hetzelfde element type'; ET_UNDECLARED_NOTATION_NAME: ErrorStr2:= 'Niet gedefinieerde notatie naam'; ET_DUPLICATE_NOTATION_ON_ELEMENT_TYPE: ErrorStr2:= 'Dubbel notatie attribuut binnen hetzelfde element type'; ET_DUPLICATE_NOTATION_TOKEN: ErrorStr2:= 'ET_DUPLICATE_NOTATION_TOKEN'; ET_NOTATION_ON_EMPTY_ELEMENT: ErrorStr2:= 'Notatie attribuut definitie voor een leeg element type'; ET_DUPLICATE_ENUMERATION_TOKEN: ErrorStr2:= 'ET_DUPLICATE_ENUMERATION_TOKEN'; ET_ATTRIBUTE_TYPE_MISMATCH: ErrorStr2:= 'Attribuut type en attribuut waarde komen niet overeen'; ET_DUPLICATE_TOKENS: ErrorStr2:= 'Tokens meermalen gedefinieerd'; ET_ID_NEITHER_IMPLIED_NOR_REQUIRED: ErrorStr2:= 'ID attribuut is niet gedefinieerd als #IMPLIED of #REQUIRED'; ET_WRONG_ROOT_ELEMENT_TYPE: ErrorStr2:= 'Type van begin element komt niet overeen met de naam van de document type declaratie'; ET_ELEMENT_TYPE_DECL_NOT_FOUND: ErrorStr2:= 'Element type declaratie niet gevonden'; ET_ELEMENT_DECLARED_EMPTY_HAS_CONTENT: ErrorStr2:= 'Element met definitie EMPTY is niet leeg'; ET_ELEMENT_WITH_ILLEGAL_MIXED_CONTENT: ErrorStr2:= 'Inhoud van een element met gemengde inhoud komt niet overeen met de declaratie'; ET_ELEMENT_WITH_ILLEGAL_ELEMENT_CONTENT: ErrorStr2:= 'Inhoud van een element met element inhoud komt niet overeen met de declaratie'; ET_NONDETERMINISTIC_ELEMENT_CONTENT_MODEL: ErrorStr2:= 'Inhoud element model is niet deterministisch'; ET_DUPLICATE_NOTATION_DECL: ErrorStr2:= 'Dubbele notatie declaratie'; ET_ATTRIBUTE_DEFINITION_NOT_FOUND: ErrorStr2:= 'Attribuut definitie niet gevonden'; ET_REQUIRED_ATTRIBUTE_NOT_FOUND: ErrorStr2:= 'Verplicht attribuut niet gevonden'; ET_FIXED_ATTRIBUTE_MISMATCH: ErrorStr2:= 'Gedefinieerde waarde en werkelijke waarde van een vast attribuut komen niet overeen'; ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH: ErrorStr2:= 'Attribuut type en attribuut default waarde komen niet overeen'; ET_DUPLICATE_ID_VALUE: ErrorStr2:= 'Dubbele ID waarde'; ET_TARGET_ID_VALUE_NOT_FOUND: ErrorStr2:= 'IDREF of IDREFS waarde verwijst naar een niet bestaande ID waarde'; ET_TARGET_UNPARSED_ENTITY_NOT_FOUND: ErrorStr2:= 'ENTITY of ENTITIES waarde verwijst naar een niet bestaande entiteit'; ET_WRONG_DECL_OF_PREDEFINED_ENTITY: ErrorStr2:= 'Foute declaratie voor een voorgedefinieerde entiteit'; ET_UNRESOLVABLE_ENTITY_REFERENCE: ErrorStr2:= 'Niet oplosbare entiteit referentie'; ET_UNRESOLVABLE_PARAMETER_ENTITY_REFERENCE: ErrorStr2:= 'Niet oplosbare parameter entiteit referentie'; ET_EXTERNAL_SUBSET_NOT_FOUND: ErrorStr2:= 'Externe subset van de DTD niet gevonden'; ET_PARAMETER_ENTITY_DECL_NOT_FOUND: ErrorStr2:= 'Parameter entiteit declaratie niet gevonden'; else ErrorStr2:= 'Fout in broncode'; end; {case ...} result:= Iso8859_1ToUTF16Str(concat(ErrorTypeStr,DocStr,ErrorStr1,' -- ',ErrorStr2)); end; function TdomError.getEnglishErrorStr: wideString; var ErrorTypeStr,DocStr,ErrorStr1,ErrorStr2: string; begin case severity of DOM_SEVERITY_FATAL_ERROR: ErrorTypeStr:='FATAL ERROR '; DOM_SEVERITY_ERROR: ErrorTypeStr:='ERROR '; DOM_SEVERITY_WARNING: ErrorTypeStr:='WARNING: '; end; with FLocation do begin DocStr:= concat('in document ',uri,' '); if lineNumber = -1 then ErrorStr1:= '' else if startLineNumber = lineNumber then begin if startColumnNumber = columnNumber then FmtStr(ErrorStr1,'in line %d, position %d',[lineNumber,columnNumber]) else FmtStr(ErrorStr1,'in line %d, between position %d and %d',[lineNumber,startColumnNumber,columnNumber]); end else begin FmtStr(ErrorStr1,'between line %d, position %d and line %d, position %d',[startLineNumber,startColumnNumber,lineNumber,columnNumber]); end; end; case FRelatedException of ET_INVALID_ELEMENT_NAME: ErrorStr2:= 'Invalid element name'; ET_DOUBLE_ROOT_ELEMENT: ErrorStr2:= 'Double root element'; ET_DOUBLE_DOCTYPE: ErrorStr2:= 'Double document type declaration (DTD)'; ET_INVALID_ATTRIBUTE_NAME: ErrorStr2:= 'Invalid attribute name'; ET_INVALID_ATTRIBUTE_VALUE: ErrorStr2:= 'Invalid attribute value'; ET_DOUBLE_ATTRIBUTE_NAME: ErrorStr2:= 'Double attribute name in one element'; ET_INVALID_ENTITY_NAME: ErrorStr2:= 'Invalid entity name'; ET_INVALID_PROCESSING_INSTRUCTION: ErrorStr2:= 'Invalid processing instruction'; ET_INVALID_XML_DECL: ErrorStr2:= 'Invalid XML declaration'; ET_INVALID_CHARREF: ErrorStr2:= 'Invalid character reference'; ET_MISSING_QUOTATION_MARK: ErrorStr2:= 'Missing quotation marks'; ET_MISSING_EQUALITY_SIGN: ErrorStr2:= 'Missing equality sign'; ET_DOUBLE_EQUALITY_SIGN: ErrorStr2:= 'Double equality sign'; ET_MISSING_WHITE_SPACE: ErrorStr2:= 'Missing white-space'; ET_MISSING_START_TAG: ErrorStr2:= 'End-tag without start-tag'; ET_MISSING_END_TAG: ErrorStr2:= 'Missing end-tag'; ET_INVALID_CHARACTER: ErrorStr2:= 'Invalid character'; ET_NOT_IN_ROOT: ErrorStr2:= 'Character(s) outside the root-element'; ET_INVALID_DOCTYPE: ErrorStr2:= 'Invalid doctype declaration'; ET_WRONG_ORDER: ErrorStr2:= 'Wrong order'; ET_UNKNOWN_DECL_TYPE: ErrorStr2:= 'Unknown declaration type'; ET_INVALID_ENTITY_DECL: ErrorStr2:= 'Invalid entity declaration'; ET_INVALID_ELEMENT_DECL: ErrorStr2:= 'Invalid element declaration'; ET_INVALID_ATTRIBUTE_DECL: ErrorStr2:= 'Invalid attribute declaration'; ET_INVALID_NOTATION_DECL: ErrorStr2:= 'Invalid notation declaration'; ET_INVALID_CONDITIONAL_SECTION: ErrorStr2:= 'Invalid conditional section'; ET_INVALID_TEXT_DECL: ErrorStr2:= 'Invalid text declaration'; ET_LT_IN_ATTRIBUTE_VALUE: ErrorStr2:= '''<'' in the replacement text of an attribute value'; ET_ATTRIBUTE_VALUE_REFERS_TO_EXTERNAL_ENTITY: ErrorStr2:= 'Attribute value refers to external entity'; ET_RECURSIVE_REFERENCE: ErrorStr2:= 'Recursive reference found'; ET_REFERENCE_TO_UNPARSED_ENTITY: ErrorStr2:= 'Reference to an unparsed entity'; ET_NO_PROPER_MARKUP_REFERENCED: ErrorStr2:= 'Reference to an entity containing no proper markup'; ET_INVALID_COMMENT: ErrorStr2:= 'Invalid comment'; ET_INVALID_CDATA_SECTION: ErrorStr2:= 'Invalid CDATA section'; ET_INVALID_SYSTEM_LITERAL: ErrorStr2:= 'Invalid system literal'; ET_INVALID_PUBID_LITERAL: ErrorStr2:= 'Invalid pubid literal'; ET_INVALID_QUALIFIED_NAME: ErrorStr2:= 'Invalid qualified name'; ET_INVALID_PREFIX: ErrorStr2:= 'Invalid prefix'; ET_INVALID_NAMESPACE_URI: ErrorStr2:= 'Invalid namespace URI'; ET_NAMESPACE_URI_NOT_FOUND: ErrorStr2:= 'Namespace URI not found'; ET_WRONG_PREFIX_MAPPING_NESTING: ErrorStr2:= 'Wrong prefix mapping nesting'; ET_ENCODING_NOT_SUPPORTED: ErrorStr2:= 'Encoding not supported'; ET_DOUBLE_ATTDEF: ErrorStr2:= 'Double attribute defintion'; ET_DOUBLE_ENTITY_DECL: ErrorStr2:= 'Double entity declaration'; ET_DOUBLE_PARAMETER_ENTITY_DECL: ErrorStr2:= 'Double parameter entity declaration'; ET_UNUSABLE_ENTITY_DECL: ErrorStr2:= 'Unusable entity declared'; ET_ENTITY_DECL_NOT_FOUND: ErrorStr2:= 'Entity declaration not found'; ET_DUPLICATE_ELEMENT_TYPE_DECL: ErrorStr2:= 'Double element type declaration'; ET_DUPLICATE_NAME_IN_MIXED_CONTENT: ErrorStr2:= 'Duplicate name in mixed content'; ET_DUPLICATE_ID_ON_ELEMENT_TYPE: ErrorStr2:= 'Duplicate ID attribute on the same element type declared'; ET_UNDECLARED_NOTATION_NAME: ErrorStr2:= 'Undeclared notation name'; ET_DUPLICATE_NOTATION_ON_ELEMENT_TYPE: ErrorStr2:= 'Duplicate notation attribute on the same element type declared'; ET_DUPLICATE_NOTATION_TOKEN: ErrorStr2:= 'Duplicate notation token'; ET_NOTATION_ON_EMPTY_ELEMENT: ErrorStr2:= 'Notation attribute on an empty element type declared'; ET_DUPLICATE_ENUMERATION_TOKEN: ErrorStr2:= 'Duplicate enumeration token'; ET_ATTRIBUTE_TYPE_MISMATCH: ErrorStr2:= 'Attribute type and attribute value do not match'; ET_DUPLICATE_TOKENS: ErrorStr2:= 'Duplicate tokens declared'; ET_ID_NEITHER_IMPLIED_NOR_REQUIRED: ErrorStr2:= 'ID attribute is neither declared as #IMPLIED nor as #REQUIRED'; ET_WRONG_ROOT_ELEMENT_TYPE: ErrorStr2:= 'Type of root element does not match name of document type declaration'; ET_ELEMENT_TYPE_DECL_NOT_FOUND: ErrorStr2:= 'Element type declaration not found'; ET_ELEMENT_DECLARED_EMPTY_HAS_CONTENT: ErrorStr2:= 'Element declared EMPTY is not empty'; ET_ELEMENT_WITH_ILLEGAL_MIXED_CONTENT: ErrorStr2:= 'Content of an element with mixed content does not match the declaration'; ET_ELEMENT_WITH_ILLEGAL_ELEMENT_CONTENT: ErrorStr2:= 'Content of an element with element content does not match the declaration'; ET_NONDETERMINISTIC_ELEMENT_CONTENT_MODEL: ErrorStr2:= 'Content model of an element is not deterministic'; ET_DUPLICATE_NOTATION_DECL: ErrorStr2:= 'Duplicate notation declaration'; ET_ATTRIBUTE_DEFINITION_NOT_FOUND: ErrorStr2:= 'Attribute definition not found'; ET_REQUIRED_ATTRIBUTE_NOT_FOUND: ErrorStr2:= 'Required attribute not found'; ET_FIXED_ATTRIBUTE_MISMATCH: ErrorStr2:= 'Declared value and actual value of a fixed attribute do not match'; ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH: ErrorStr2:= 'Attribute type and attribute default do not match'; ET_DUPLICATE_ID_VALUE: ErrorStr2:= 'Duplicate ID value'; ET_TARGET_ID_VALUE_NOT_FOUND: ErrorStr2:= 'IDREF or IDREFS value refers to a non-existent target ID value'; ET_TARGET_UNPARSED_ENTITY_NOT_FOUND: ErrorStr2:= 'ENTITY or ENTITIES value refers to a non-existent target unparsed entity'; ET_WRONG_DECL_OF_PREDEFINED_ENTITY: ErrorStr2:= 'Wrong declaration of a predefined entity'; ET_UNRESOLVABLE_ENTITY_REFERENCE: ErrorStr2:= 'Unresolvable entity reference'; ET_UNRESOLVABLE_PARAMETER_ENTITY_REFERENCE: ErrorStr2:= 'Unresolvable parameter entity reference'; ET_EXTERNAL_SUBSET_NOT_FOUND: ErrorStr2:= 'External subset of the DTD not found'; ET_PARAMETER_ENTITY_DECL_NOT_FOUND: ErrorStr2:= 'Parameter entity declaration not found'; else ErrorStr2:= 'Invalid source-code'; end; {case ...} result:= Iso8859_1ToUTF16Str(concat(ErrorTypeStr,DocStr,ErrorStr1,' -- ',ErrorStr2)); end; function TdomError.getFrenchErrorStr: wideString; // - This function was provided by Bernard Eblin - var ErrorTypeStr,DocStr,ErrorStr1,ErrorStr2: string; begin case severity of DOM_SEVERITY_FATAL_ERROR: ErrorTypeStr:='ERREUR FATALE '; DOM_SEVERITY_ERROR: ErrorTypeStr:='ERREUR '; DOM_SEVERITY_WARNING: ErrorTypeStr:='ATTENTION: '; end; with FLocation do begin DocStr:= concat('dans le document ',uri,' '); if lineNumber = -1 then ErrorStr1:= '' else if startLineNumber = lineNumber then begin if startColumnNumber = columnNumber then FmtStr(ErrorStr1,'à la ligne %d, position %d',[lineNumber,columnNumber]) else FmtStr(ErrorStr1,'à la ligne %d, entre la position %d et %d',[lineNumber,startColumnNumber,columnNumber]); end else begin FmtStr(ErrorStr1,'entre la ligne %d, position %d et la ligne %d, position %d',[startLineNumber,startColumnNumber,lineNumber,columnNumber]); end; end; case FRelatedException of ET_INVALID_ELEMENT_NAME: ErrorStr2:= 'Nom d'';élément invalide'; ET_DOUBLE_ROOT_ELEMENT: ErrorStr2:= 'Double élément racine'; ET_DOUBLE_DOCTYPE: ErrorStr2:= 'Double déclaration de type de document (DTD)'; ET_INVALID_ATTRIBUTE_NAME: ErrorStr2:= 'Nom d'';attribut invalide'; ET_INVALID_ATTRIBUTE_VALUE: ErrorStr2:= 'Valeur d'';attribut invalide'; ET_DOUBLE_ATTRIBUTE_NAME: ErrorStr2:= 'Double nom d'';atribut dans un élément'; ET_INVALID_ENTITY_NAME: ErrorStr2:= 'Nom d'';entité invalide'; ET_INVALID_PROCESSING_INSTRUCTION: ErrorStr2:= 'Instruction de commande invalide'; ET_INVALID_XML_DECL: ErrorStr2:= 'Déclaration XML invalide'; ET_INVALID_CHARREF: ErrorStr2:= 'Référence de caractère invalide'; ET_MISSING_QUOTATION_MARK: ErrorStr2:= 'Apostrophe (''): manquant'; ET_MISSING_EQUALITY_SIGN: ErrorStr2:= 'Signe égale manquant'; ET_DOUBLE_EQUALITY_SIGN: ErrorStr2:= 'Double signe égale'; ET_MISSING_WHITE_SPACE: ErrorStr2:= 'Espace manquant'; ET_MISSING_START_TAG: ErrorStr2:= 'Tag de fin sans tag de début'; ET_MISSING_END_TAG: ErrorStr2:= 'Tag de fin manquant'; ET_INVALID_CHARACTER: ErrorStr2:= 'Caractère invalide'; ET_NOT_IN_ROOT: ErrorStr2:= 'Caractère(s) en dehors de l'';élément racine'; ET_INVALID_DOCTYPE: ErrorStr2:= 'Déclaration de type de document invalide'; ET_WRONG_ORDER: ErrorStr2:= 'Mauvais ordre'; ET_UNKNOWN_DECL_TYPE: ErrorStr2:= 'Déclaration de type inconnue'; ET_INVALID_ENTITY_DECL: ErrorStr2:= 'Déclaration d'';entité invalide'; ET_INVALID_ELEMENT_DECL: ErrorStr2:= 'Déclaration d'';élément invalide'; ET_INVALID_ATTRIBUTE_DECL: ErrorStr2:= 'Déclaration d'';attribut invalide'; ET_INVALID_NOTATION_DECL: ErrorStr2:= 'Déclaration de notation invalide'; ET_INVALID_CONDITIONAL_SECTION: ErrorStr2:= 'Section conditionnelle invalide'; ET_INVALID_TEXT_DECL: ErrorStr2:= 'Déclaration de texte invalide'; ET_LT_IN_ATTRIBUTE_VALUE: ErrorStr2:= 'ET_LT_IN_ATTRIBUTE_VALUE'; ET_ATTRIBUTE_VALUE_REFERS_TO_EXTERNAL_ENTITY: ErrorStr2:= 'ET_ATTRIBUTE_VALUE_REFERS_TO_EXTERNAL_ENTITY'; ET_RECURSIVE_REFERENCE: ErrorStr2:= 'ET_RECURSIVE_REFERENCE'; ET_REFERENCE_TO_UNPARSED_ENTITY: ErrorStr2:= 'ET_REFERENCE_TO_UNPARSED_ENTITY'; ET_NO_PROPER_MARKUP_REFERENCED: ErrorStr2:= 'ET_NO_PROPER_MARKUP_REFERENCED'; ET_INVALID_COMMENT: ErrorStr2:= 'ET_INVALID_COMMENT'; ET_INVALID_CDATA_SECTION: ErrorStr2:= 'ET_INVALID_CDATA_SECTION'; ET_INVALID_SYSTEM_LITERAL: ErrorStr2:= 'ET_INVALID_SYSTEM_LITERAL'; ET_INVALID_PUBID_LITERAL: ErrorStr2:= 'ET_INVALID_PUBID_LITERAL'; ET_INVALID_QUALIFIED_NAME: ErrorStr2:= 'ET_INVALID_QUALIFIED_NAME'; ET_INVALID_PREFIX: ErrorStr2:= 'ET_INVALID_PREFIX'; ET_INVALID_NAMESPACE_URI: ErrorStr2:= 'ET_INVALID_NAMESPACE_URI'; ET_NAMESPACE_URI_NOT_FOUND: ErrorStr2:= 'ET_NAMESPACE_URI_NOT_FOUND'; ET_WRONG_PREFIX_MAPPING_NESTING: ErrorStr2:= 'ET_WRONG_PREFIX_MAPPING_NESTING'; ET_ENCODING_NOT_SUPPORTED: ErrorStr2:= 'ET_ENCODING_NOT_SUPPORTED'; ET_DOUBLE_ATTDEF: ErrorStr2:= 'ET_DOUBLE_ATTDEF'; ET_DOUBLE_ENTITY_DECL: ErrorStr2:= 'Double déclaration d'';entité'; ET_DOUBLE_PARAMETER_ENTITY_DECL: ErrorStr2:= 'Double déclaration d'';entité paramètre'; ET_UNUSABLE_ENTITY_DECL: ErrorStr2:= 'ET_UNUSABLE_ENTITY_DECL'; ET_ENTITY_DECL_NOT_FOUND: ErrorStr2:= 'ET_ENTITY_DECL_NOT_FOUND'; ET_DUPLICATE_ELEMENT_TYPE_DECL: ErrorStr2:= 'ET_DUPLICATE_ELEMENT_TYPE_DECL'; ET_DUPLICATE_NAME_IN_MIXED_CONTENT: ErrorStr2:= 'ET_DUPLICATE_NAME_IN_MIXED_CONTENT'; ET_DUPLICATE_ID_ON_ELEMENT_TYPE: ErrorStr2:= 'ET_DUPLICATE_ID_ON_ELEMENT_TYPE'; ET_UNDECLARED_NOTATION_NAME: ErrorStr2:= 'ET_UNDECLARED_NOTATION_NAME'; ET_DUPLICATE_NOTATION_ON_ELEMENT_TYPE: ErrorStr2:= 'ET_DUPLICATE_NOTATION_ON_ELEMENT_TYPE'; ET_DUPLICATE_NOTATION_TOKEN: ErrorStr2:= 'ET_DUPLICATE_NOTATION_TOKEN'; ET_NOTATION_ON_EMPTY_ELEMENT: ErrorStr2:= 'ET_NOTATION_ON_EMPTY_ELEMENT'; ET_DUPLICATE_ENUMERATION_TOKEN: ErrorStr2:= 'ET_DUPLICATE_ENUMERATION_TOKEN'; ET_ATTRIBUTE_TYPE_MISMATCH: ErrorStr2:= 'ET_ATTRIBUTE_TYPE_MISMATCH'; ET_DUPLICATE_TOKENS: ErrorStr2:= 'ET_DUPLICATE_TOKENS'; ET_ID_NEITHER_IMPLIED_NOR_REQUIRED: ErrorStr2:= 'ET_ID_NEITHER_IMPLIED_NOR_REQUIRED'; ET_WRONG_ROOT_ELEMENT_TYPE: ErrorStr2:= 'ET_WRONG_ROOT_ELEMENT_TYPE'; ET_ELEMENT_TYPE_DECL_NOT_FOUND: ErrorStr2:= 'ET_ELEMENT_TYPE_DECL_NOT_FOUND'; ET_ELEMENT_DECLARED_EMPTY_HAS_CONTENT: ErrorStr2:= 'ET_ELEMENT_DECLARED_EMPTY_HAS_CONTENT'; ET_ELEMENT_WITH_ILLEGAL_MIXED_CONTENT: ErrorStr2:= 'ET_ELEMENT_WITH_ILLEGAL_MIXED_CONTENT'; ET_ELEMENT_WITH_ILLEGAL_ELEMENT_CONTENT: ErrorStr2:= 'ET_ELEMENT_WITH_ILLEGAL_ELEMENT_CONTENT'; ET_NONDETERMINISTIC_ELEMENT_CONTENT_MODEL: ErrorStr2:= 'ET_NONDETERMINISTIC_ELEMENT_CONTENT_MODEL'; ET_DUPLICATE_NOTATION_DECL: ErrorStr2:= 'Double déclaration de notation'; ET_ATTRIBUTE_DEFINITION_NOT_FOUND: ErrorStr2:= 'ET_ATTRIBUTE_DEFINITION_NOT_FOUND'; ET_REQUIRED_ATTRIBUTE_NOT_FOUND: ErrorStr2:= 'ET_REQUIRED_ATTRIBUTE_NOT_FOUND'; ET_FIXED_ATTRIBUTE_MISMATCH: ErrorStr2:= 'ET_FIXED_ATTRIBUTE_MISMATCH'; ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH: ErrorStr2:= 'ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH'; ET_DUPLICATE_ID_VALUE: ErrorStr2:= 'ET_DUPLICATE_ID_VALUE'; ET_TARGET_ID_VALUE_NOT_FOUND: ErrorStr2:= 'ET_TARGET_ID_VALUE_NOT_FOUND'; ET_TARGET_UNPARSED_ENTITY_NOT_FOUND: ErrorStr2:= 'ET_TARGET_UNPARSED_ENTITY_NOT_FOUND'; ET_WRONG_DECL_OF_PREDEFINED_ENTITY: ErrorStr2:= 'ET_WRONG_DECL_OF_PREDEFINED_ENTITY'; ET_UNRESOLVABLE_ENTITY_REFERENCE: ErrorStr2:= 'ET_UNRESOLVABLE_ENTITY_REFERENCE'; ET_UNRESOLVABLE_PARAMETER_ENTITY_REFERENCE: ErrorStr2:= 'ET_UNRESOLVABLE_PARAMETER_ENTITY_REFERENCE'; ET_EXTERNAL_SUBSET_NOT_FOUND: ErrorStr2:= 'ET_EXTERNAL_SUBSET_NOT_FOUND'; ET_PARAMETER_ENTITY_DECL_NOT_FOUND: ErrorStr2:= 'ET_PARAMETER_ENTITY_DECL_NOT_FOUND'; else ErrorStr2:= 'Code source invalide'; end; {case ...} result:= Iso8859_1ToUTF16Str(concat(ErrorTypeStr,DocStr,ErrorStr1,' -- ',ErrorStr2)); end; function TdomError.getGermanErrorStr: wideString; var DocStr,ErrorTypeStr,ErrorStr1,ErrorStr2: string; begin case severity of DOM_SEVERITY_FATAL_ERROR: ErrorTypeStr:='KRITISCHER FEHLER '; DOM_SEVERITY_ERROR: ErrorTypeStr:='FEHLER '; DOM_SEVERITY_WARNING: ErrorTypeStr:='WARNUNG: '; end; with FLocation do begin DocStr:= concat('im Dokument ',uri,' '); if lineNumber = -1 then ErrorStr1:= '' else if startLineNumber = lineNumber then begin if startColumnNumber = columnNumber then FmtStr(ErrorStr1,'in Zeile %d, Position %d',[lineNumber,columnNumber]) else FmtStr(ErrorStr1,'in Zeile %d, zwischen Position %d und %d',[lineNumber,startColumnNumber,columnNumber]); end else begin FmtStr(ErrorStr1,'zwischen Zeile %d, Position %d und Zeile %d, Position %d',[startLineNumber,startColumnNumber,lineNumber,columnNumber]); end; end; case FRelatedException of ET_INVALID_ELEMENT_NAME: ErrorStr2:= 'Ungültiger Element-name'; ET_DOUBLE_ROOT_ELEMENT: ErrorStr2:= 'Doppeltes Wurzel-Element'; ET_DOUBLE_DOCTYPE: ErrorStr2:= 'Doppelte Dokument-Typ-Deklaration (DTD)'; ET_INVALID_ATTRIBUTE_NAME: ErrorStr2:= 'Ungültiger Attribut-name'; ET_INVALID_ATTRIBUTE_VALUE: ErrorStr2:= 'Ungültiger Attribut-Wert'; ET_DOUBLE_ATTRIBUTE_NAME: ErrorStr2:= 'Doppelter Attributname in einem Element'; ET_INVALID_ENTITY_NAME: ErrorStr2:= 'Ungültiger Entität-name'; ET_INVALID_PROCESSING_INSTRUCTION: ErrorStr2:= 'Ungültige Processing-Instruction'; ET_INVALID_XML_DECL: ErrorStr2:= 'Ungültige XML-Deklaration'; ET_INVALID_CHARREF: ErrorStr2:= 'Ungültige Zeichen-Referenz'; ET_MISSING_QUOTATION_MARK: ErrorStr2:= 'Fehlende Anführungszeichen'; ET_MISSING_EQUALITY_SIGN: ErrorStr2:= 'Fehlendes Gleichheitszeichen'; ET_DOUBLE_EQUALITY_SIGN: ErrorStr2:= 'Doppeltes Gleichheitszeichen'; ET_MISSING_WHITE_SPACE: ErrorStr2:= 'Fehlender Leerraum'; ET_MISSING_START_TAG: ErrorStr2:= 'End-Tag ohne Start-Tag'; ET_MISSING_END_TAG: ErrorStr2:= 'Fehlendes End-Tag'; ET_INVALID_CHARACTER: ErrorStr2:= 'Ungültiges Zeichen'; ET_NOT_IN_ROOT: ErrorStr2:= 'Zeichen außerhalb des Wurzel-Elements'; ET_INVALID_DOCTYPE: ErrorStr2:= 'Ungültige Dokumenttyp-Deklaration'; ET_WRONG_ORDER: ErrorStr2:= 'Falsche Reihenfolge'; ET_UNKNOWN_DECL_TYPE: ErrorStr2:= 'Unbekannter Deklarationstyp'; ET_INVALID_ENTITY_DECL: ErrorStr2:= 'Ungültige Entität-Deklaration'; ET_INVALID_ELEMENT_DECL: ErrorStr2:= 'Ungültige Element-Deklaration'; ET_INVALID_ATTRIBUTE_DECL: ErrorStr2:= 'Ungültige Attribut-Deklaration'; ET_INVALID_NOTATION_DECL: ErrorStr2:= 'Ungültige Notations-Deklaration'; ET_INVALID_CONDITIONAL_SECTION: ErrorStr2:= 'Ungültiger bedingter Abschnitt'; ET_INVALID_TEXT_DECL: ErrorStr2:= 'Ungültige Text-Deklaration'; ET_LT_IN_ATTRIBUTE_VALUE: ErrorStr2:= '''<'' im Ersetzungstext eines Attributwertes'; ET_ATTRIBUTE_VALUE_REFERS_TO_EXTERNAL_ENTITY: ErrorStr2:= 'Attribut-Wert verweist auf eine externe Entität'; ET_RECURSIVE_REFERENCE: ErrorStr2:= 'Rekursive Referenz gefunden'; ET_REFERENCE_TO_UNPARSED_ENTITY: ErrorStr2:= 'Referenz auf eine nicht analysierte Entität'; ET_NO_PROPER_MARKUP_REFERENCED: ErrorStr2:= 'Referenz auf eine Entität mit ungültigen Markierunszeichen'; ET_INVALID_COMMENT: ErrorStr2:= 'Ungültiger Kommentar'; ET_INVALID_CDATA_SECTION: ErrorStr2:= 'Ungültiger CDATA-Abschnitt'; ET_INVALID_SYSTEM_LITERAL: ErrorStr2:= 'Ungültiges System-Literal'; ET_INVALID_PUBID_LITERAL: ErrorStr2:= 'Ungültiges Pubid-Literal'; ET_INVALID_QUALIFIED_NAME: ErrorStr2:= 'Ungültiger qualifizierter Name'; ET_INVALID_PREFIX: ErrorStr2:= 'Ungültiges Prefix'; ET_INVALID_NAMESPACE_URI: ErrorStr2:= 'Ungültiger Namensraum-URI'; ET_NAMESPACE_URI_NOT_FOUND: ErrorStr2:= 'Namensraum-URI nicht gefunden'; ET_WRONG_PREFIX_MAPPING_NESTING: ErrorStr2:= 'Falsche Prefix-Verschachtelung'; ET_ENCODING_NOT_SUPPORTED: ErrorStr2:= 'Nicht-unterstütze Zeichencodierung'; ET_DOUBLE_ATTDEF: ErrorStr2:= 'Doppelte Attribut-Defintion'; ET_DOUBLE_ENTITY_DECL: ErrorStr2:= 'Doppelte Entität-Deklaration'; ET_DOUBLE_PARAMETER_ENTITY_DECL: ErrorStr2:= 'Doppelte Parameter-Entität-Deklaration'; ET_UNUSABLE_ENTITY_DECL: ErrorStr2:= 'Unbrauchbare Entität deklariert'; ET_ENTITY_DECL_NOT_FOUND: ErrorStr2:= 'Entität-Declaration nicht gefunden'; ET_DUPLICATE_ELEMENT_TYPE_DECL: ErrorStr2:= 'Doppelte Element-Typ-Deklaration'; ET_DUPLICATE_NAME_IN_MIXED_CONTENT: ErrorStr2:= 'Doppelter Name in gemischtem Inhalt'; ET_DUPLICATE_ID_ON_ELEMENT_TYPE: ErrorStr2:= 'ID-Attribut mehrfach für denselben Element-Typ deklariert'; ET_UNDECLARED_NOTATION_NAME: ErrorStr2:= 'Notationsname nicht deklariert'; ET_DUPLICATE_NOTATION_ON_ELEMENT_TYPE: ErrorStr2:= 'Notationsattribut mehrfach für denselben Element-Typ deklariert'; ET_DUPLICATE_NOTATION_TOKEN: ErrorStr2:= 'Doppelte Notationstokens'; ET_NOTATION_ON_EMPTY_ELEMENT: ErrorStr2:= 'Notationsattribut für einen leeren Element-Typ deklariert'; ET_DUPLICATE_ENUMERATION_TOKEN: ErrorStr2:= 'Doppeltes Aufzählungstoken'; ET_ATTRIBUTE_TYPE_MISMATCH: ErrorStr2:= 'Attribut-Typ und Attribut-Wert stimmen nicht überein'; ET_DUPLICATE_TOKENS: ErrorStr2:= 'Token mehrfach deklariert'; ET_ID_NEITHER_IMPLIED_NOR_REQUIRED: ErrorStr2:= 'ID-Attribut ist weder als #IMPLIED noch als #REQUIRED deklariert'; ET_WRONG_ROOT_ELEMENT_TYPE: ErrorStr2:= 'Typ des Wurzelelements entspricht nicht der Angabe in der Dokumenttyp-Deklaration'; ET_ELEMENT_TYPE_DECL_NOT_FOUND: ErrorStr2:= 'Elementtyp-Deklaration nicht gefunden'; ET_ELEMENT_DECLARED_EMPTY_HAS_CONTENT: ErrorStr2:= 'Als EMPTY deklariertes Element ist nicht leer'; ET_ELEMENT_WITH_ILLEGAL_MIXED_CONTENT: ErrorStr2:= 'Inhalt eines Elements gemischten Inhalts entspricht nicht der Deklaration'; ET_ELEMENT_WITH_ILLEGAL_ELEMENT_CONTENT: ErrorStr2:= 'Inhalt eines Elements mit Element-Inhalt entspricht nicht der Deklaration'; ET_NONDETERMINISTIC_ELEMENT_CONTENT_MODEL: ErrorStr2:= 'Inhaltsmodell eines Elements ist nicht deterministisch'; ET_DUPLICATE_NOTATION_DECL: ErrorStr2:= 'Doppelte Notationsdeklaration'; ET_ATTRIBUTE_DEFINITION_NOT_FOUND: ErrorStr2:= 'Attribut-Definition nicht gefunden'; ET_REQUIRED_ATTRIBUTE_NOT_FOUND: ErrorStr2:= 'Als "#REQUIRED" deklariertes Attribut nicht gefunden'; ET_FIXED_ATTRIBUTE_MISMATCH: ErrorStr2:= 'Werte eines als "#FIXED" deklarierten Attributs entspricht nicht der Deklaration'; ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH: ErrorStr2:= 'Attribut-Typ und Attribut-Vorgabe stimmen nicht überein'; ET_DUPLICATE_ID_VALUE: ErrorStr2:= 'ID-Wert mehrfach verwendet'; ET_TARGET_ID_VALUE_NOT_FOUND: ErrorStr2:= 'Ein IDREF- bzw. IDREFS-Attribute verweist auf ein nicht vorhandenes Ziel'; ET_TARGET_UNPARSED_ENTITY_NOT_FOUND: ErrorStr2:= 'Ein ENTITY- bzw. ENTITIES-Attribute verweist auf eine nicht analysierte Entität, die nicht deklariert wurde'; ET_WRONG_DECL_OF_PREDEFINED_ENTITY: ErrorStr2:= 'Falsche Deklaration einer vordefinierten Entität'; ET_UNRESOLVABLE_ENTITY_REFERENCE: ErrorStr2:= 'Nicht auflösbare Entitäten-Referenz'; ET_UNRESOLVABLE_PARAMETER_ENTITY_REFERENCE: ErrorStr2:= 'Nicht auflösbare Parameter-Entitäten-Referenz'; ET_EXTERNAL_SUBSET_NOT_FOUND: ErrorStr2:= 'Externe Teilmenge der DTD nicht gefunden'; ET_PARAMETER_ENTITY_DECL_NOT_FOUND: ErrorStr2:= 'Parameter-Entität-Deklaration nicht gefunden'; else ErrorStr2:= 'Ungültiger Quellcode'; end; {case ...} result:= Iso8859_1ToUTF16Str(concat(ErrorTypeStr,DocStr,ErrorStr1,' -- ',ErrorStr2)); end; function TdomError.getItalianErrorStr: wideString; // - This function was provided by Massimo Maria Ghisalberti - var ErrorTypeStr,DocStr,ErrorStr1,ErrorStr2: string; begin case severity of DOM_SEVERITY_FATAL_ERROR: ErrorTypeStr:='ERRORE CRITICO '; DOM_SEVERITY_ERROR: ErrorTypeStr:='ERRORE '; DOM_SEVERITY_WARNING: ErrorTypeStr:='ATTENZIONE: '; end; with FLocation do begin DocStr:= concat('nel documento ',uri,' '); if lineNumber = -1 then ErrorStr1:= '' else if startLineNumber = lineNumber then begin if startColumnNumber = columnNumber then FmtStr(ErrorStr1,'nella linea %d, posizione %d',[lineNumber,columnNumber]) else FmtStr(ErrorStr1,'nella linea %d, tra la posizione %d e %d',[lineNumber,startColumnNumber,columnNumber]); end else begin FmtStr(ErrorStr1,'tra la linea %d, posizione %d e la linea %d, posizione %d',[startLineNumber,startColumnNumber,lineNumber,columnNumber]); end; end; case FRelatedException of ET_INVALID_ELEMENT_NAME: ErrorStr2:= 'Nome elemento non valido'; ET_DOUBLE_ROOT_ELEMENT: ErrorStr2:= 'Elemento radice duplicato'; ET_DOUBLE_DOCTYPE: ErrorStr2:= 'Dichiarazione del tipo di documento (DTD) duplicata'; ET_INVALID_ATTRIBUTE_NAME: ErrorStr2:= 'Nome attributo non valido'; ET_INVALID_ATTRIBUTE_VALUE: ErrorStr2:= 'Valore attributo non valido'; ET_DOUBLE_ATTRIBUTE_NAME: ErrorStr2:= 'Nome dell''attributo duplicato in un elemento'; ET_INVALID_ENTITY_NAME: ErrorStr2:= 'Nome entità non valido'; ET_INVALID_PROCESSING_INSTRUCTION: ErrorStr2:= 'Istruzione di processo non valida'; ET_INVALID_XML_DECL: ErrorStr2:= 'Dichiarazione XML non valida'; ET_INVALID_CHARREF: ErrorStr2:= 'Riferimento a carattere non valida'; ET_MISSING_QUOTATION_MARK: ErrorStr2:= 'Virgolette mancanti'; ET_MISSING_EQUALITY_SIGN: ErrorStr2:= 'Segno di uguale mancante'; ET_DOUBLE_EQUALITY_SIGN: ErrorStr2:= 'Segno di uguale duplicato'; ET_MISSING_WHITE_SPACE: ErrorStr2:= 'Spazio mancante'; ET_MISSING_START_TAG: ErrorStr2:= 'Tag finale senza tag iniziale'; ET_MISSING_END_TAG: ErrorStr2:= 'Tag finale mancante'; ET_INVALID_CHARACTER: ErrorStr2:= 'Carattere non valido'; ET_NOT_IN_ROOT: ErrorStr2:= 'Carattere(i) oltre l''elemento radice'; ET_INVALID_DOCTYPE: ErrorStr2:= 'Dichiarazione del tipo di documento non valida'; ET_WRONG_ORDER: ErrorStr2:= 'Ordine errato'; ET_UNKNOWN_DECL_TYPE: ErrorStr2:= 'Dichiarazione di tipo sconosciuta'; ET_INVALID_ENTITY_DECL: ErrorStr2:= 'Dichiarazione di entità non valida'; ET_INVALID_ELEMENT_DECL: ErrorStr2:= 'Dichiarazione di elemento non valida'; ET_INVALID_ATTRIBUTE_DECL: ErrorStr2:= 'Dichiarazione di attributo non valida'; ET_INVALID_NOTATION_DECL: ErrorStr2:= 'Dichiarazione di notazione non valida'; ET_INVALID_CONDITIONAL_SECTION: ErrorStr2:= 'Sezione condizionale non valida'; ET_INVALID_TEXT_DECL: ErrorStr2:= 'Dichiarazione di testo non valida'; ET_LT_IN_ATTRIBUTE_VALUE: ErrorStr2:= 'Tovato il carattere ''<'' nel valore di un attributo'; ET_ATTRIBUTE_VALUE_REFERS_TO_EXTERNAL_ENTITY: ErrorStr2:= 'Il valore dell''attributo si riferisce ad un''entità esterna'; ET_RECURSIVE_REFERENCE: ErrorStr2:= 'ET_RECURSIVE_REFERENCE'; ET_REFERENCE_TO_UNPARSED_ENTITY: ErrorStr2:= 'Riferimento ad una entità non analizzata'; ET_NO_PROPER_MARKUP_REFERENCED: ErrorStr2:= 'Riferimento ad una entità senza un marcatore adeguato'; ET_INVALID_COMMENT: ErrorStr2:= 'ET_INVALID_COMMENT'; ET_INVALID_CDATA_SECTION: ErrorStr2:= 'ET_INVALID_CDATA_SECTION'; ET_INVALID_SYSTEM_LITERAL: ErrorStr2:= 'ET_INVALID_SYSTEM_LITERAL'; ET_INVALID_PUBID_LITERAL: ErrorStr2:= 'ET_INVALID_PUBID_LITERAL'; ET_INVALID_QUALIFIED_NAME: ErrorStr2:= 'ET_INVALID_QUALIFIED_NAME'; ET_INVALID_PREFIX: ErrorStr2:= 'ET_INVALID_PREFIX'; ET_INVALID_NAMESPACE_URI: ErrorStr2:= 'ET_INVALID_NAMESPACE_URI'; ET_NAMESPACE_URI_NOT_FOUND: ErrorStr2:= 'ET_NAMESPACE_URI_NOT_FOUND'; ET_WRONG_PREFIX_MAPPING_NESTING: ErrorStr2:= 'ET_WRONG_PREFIX_MAPPING_NESTING'; ET_ENCODING_NOT_SUPPORTED: ErrorStr2:= 'ET_ENCODING_NOT_SUPPORTED'; ET_DOUBLE_ATTDEF: ErrorStr2:= 'Definizione di attibuto duplicata'; ET_DOUBLE_ENTITY_DECL: ErrorStr2:= 'Dichiarazione di entità duplicata'; ET_DOUBLE_PARAMETER_ENTITY_DECL: ErrorStr2:= 'Dichiarazione di entità con parametri duplicati'; ET_UNUSABLE_ENTITY_DECL: ErrorStr2:= 'Entità dichiarata non utilizzabile'; ET_ENTITY_DECL_NOT_FOUND: ErrorStr2:= 'Dichiarazione di entità non trovata'; ET_DUPLICATE_ELEMENT_TYPE_DECL: ErrorStr2:= 'Dichiarazione di tipo dell''elemento duplicata'; ET_DUPLICATE_NAME_IN_MIXED_CONTENT: ErrorStr2:= 'Nome duplicato in un contenuto misto'; ET_DUPLICATE_ID_ON_ELEMENT_TYPE: ErrorStr2:= 'Attributo ID duplicato nella stessa dichiarazione di tipo di elemento'; ET_UNDECLARED_NOTATION_NAME: ErrorStr2:= 'Nome di notazione non dichiarato'; ET_DUPLICATE_NOTATION_ON_ELEMENT_TYPE: ErrorStr2:= 'Attributo di notazione duplicato nello stessa dichiarazione di tipo di elemento'; ET_DUPLICATE_NOTATION_TOKEN: ErrorStr2:= 'ET_DUPLICATE_NOTATION_TOKEN'; ET_NOTATION_ON_EMPTY_ELEMENT: ErrorStr2:= 'Attributo di notazione nella dichiarazione di tipo di elemento vuoto'; ET_DUPLICATE_ENUMERATION_TOKEN: ErrorStr2:= 'ET_DUPLICATE_ENUMERATION_TOKEN'; ET_ATTRIBUTE_TYPE_MISMATCH: ErrorStr2:= 'L''attributo di tipo e il valore non coincidono'; ET_DUPLICATE_TOKENS: ErrorStr2:= 'Dichiarazione duplicata di token'; ET_ID_NEITHER_IMPLIED_NOR_REQUIRED: ErrorStr2:= 'L''attributo ID non è stato dichiarato come #IMPLIED né come #REQUIRED'; ET_WRONG_ROOT_ELEMENT_TYPE: ErrorStr2:= 'Il tipo dell''elemento radice non coincide con il nome della dichiarazione di tipo del documento'; ET_ELEMENT_TYPE_DECL_NOT_FOUND: ErrorStr2:= 'Dichiarazione del tipo dell''elemento non trovata'; ET_ELEMENT_DECLARED_EMPTY_HAS_CONTENT: ErrorStr2:= 'L''elemento dichiarato vuoto non lo è'; ET_ELEMENT_WITH_ILLEGAL_MIXED_CONTENT: ErrorStr2:= 'Il contenuto di un elemento con contenuto misto non coincide con la dichiarazione'; ET_ELEMENT_WITH_ILLEGAL_ELEMENT_CONTENT: ErrorStr2:= 'Il contenuto di un elemento che contiene elementi non coincide con la dichiarazione'; ET_NONDETERMINISTIC_ELEMENT_CONTENT_MODEL: ErrorStr2:= 'Il modello di contenuto di un elemento non è deterministico'; ET_DUPLICATE_NOTATION_DECL: ErrorStr2:= 'Dichiarazione di notazione duplicata'; ET_ATTRIBUTE_DEFINITION_NOT_FOUND: ErrorStr2:= 'Definizione di attributo non trovata'; ET_REQUIRED_ATTRIBUTE_NOT_FOUND: ErrorStr2:= 'Attributo richiesto non trovato'; ET_FIXED_ATTRIBUTE_MISMATCH: ErrorStr2:= 'Il valore dichiarato e quello attuale di un attributo fisso non coincidono'; ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH: ErrorStr2:= 'Il tipo di un attributo ed il suo predefinito non coincidono'; ET_DUPLICATE_ID_VALUE: ErrorStr2:= 'Valore ID duplicato'; ET_TARGET_ID_VALUE_NOT_FOUND: ErrorStr2:= 'Il valore IDREF o IDREFS si riferisce ad un valore ID inesistente'; ET_TARGET_UNPARSED_ENTITY_NOT_FOUND: ErrorStr2:= 'Il valore ENTITY o ENTITIES si riferisce ad una entità non analizzata non esistente'; ET_WRONG_DECL_OF_PREDEFINED_ENTITY: ErrorStr2:= 'Dichiarazione di entità predefinita errata'; ET_UNRESOLVABLE_ENTITY_REFERENCE: ErrorStr2:= 'Riferimento non risolvibile ad una entità'; ET_UNRESOLVABLE_PARAMETER_ENTITY_REFERENCE: ErrorStr2:= 'Riferimento non risolvibile ad una entità con parametri'; ET_EXTERNAL_SUBSET_NOT_FOUND: ErrorStr2:= 'ET_EXTERNAL_SUBSET_NOT_FOUND'; ET_PARAMETER_ENTITY_DECL_NOT_FOUND: ErrorStr2:= 'ET_PARAMETER_ENTITY_DECL_NOT_FOUND'; else ErrorStr2:= 'Codice sorgente non valido'; end; {case ...} result:= Iso8859_1ToUTF16Str(concat(ErrorTypeStr,DocStr,ErrorStr1,' -- ',ErrorStr2)); end; function TdomError.getPolishErrorStr: wideString; // - This function was provided by Piotr Kuczynski - var ErrorTypeStr,DocStr,ErrorStr1,ErrorStr2: string; begin case severity of DOM_SEVERITY_FATAL_ERROR: ErrorTypeStr:='FATALNY B£¥D '; DOM_SEVERITY_ERROR: ErrorTypeStr:='B£¥D '; DOM_SEVERITY_WARNING: ErrorTypeStr:='OSTRZE¯ENIE: '; end; with FLocation do begin DocStr:= concat('w dokumencie ',uri,' '); if lineNumber = -1 then ErrorStr1:= '' else if startLineNumber = lineNumber then begin if startColumnNumber = columnNumber then FmtStr(ErrorStr1,'w linii %d, znak %d',[lineNumber,columnNumber]) else FmtStr(ErrorStr1,'w linii %d, pomiêdzy znakiem %d i %d',[lineNumber,startColumnNumber,columnNumber]); end else begin FmtStr(ErrorStr1,'pomiêdzy lini¹ %d, znak %d i lini¹ %d, znak %d',[startLineNumber,startColumnNumber,lineNumber,columnNumber]); end; end; case FRelatedException of ET_INVALID_ELEMENT_NAME: ErrorStr2:= 'Niew³aœciwa nazwa elementu'; ET_DOUBLE_ROOT_ELEMENT: ErrorStr2:= 'Podwójnie zdefiniowany korzeñ'; ET_DOUBLE_DOCTYPE: ErrorStr2:= 'Podwójna deklaracja typu dokumentu (DTD)'; ET_INVALID_ATTRIBUTE_NAME: ErrorStr2:= 'Niew³aœciwa nazwa atrybutu'; ET_INVALID_ATTRIBUTE_VALUE: ErrorStr2:= 'Niew³aœciwa wartoœæ atrybutu'; ET_DOUBLE_ATTRIBUTE_NAME: ErrorStr2:= 'Powtarzaj¹ca siê nazwa atrybutu'; ET_INVALID_ENTITY_NAME: ErrorStr2:= 'Niew³aœciwa nazwa encji'; ET_INVALID_PROCESSING_INSTRUCTION: ErrorStr2:= 'Niew³aœciwa instrukcja przetwarzania'; ET_INVALID_XML_DECL: ErrorStr2:= 'Niew³aœciwa deklaracja XML'; ET_INVALID_CHARREF: ErrorStr2:= 'Niew³aœciwy znak w odwo³aniu'; ET_MISSING_QUOTATION_MARK: ErrorStr2:= 'Brakuj¹cy cudzys³ów'; ET_MISSING_EQUALITY_SIGN: ErrorStr2:= 'Brakuj¹cy znak równoœci'; ET_DOUBLE_EQUALITY_SIGN: ErrorStr2:= 'Podwójny znak równoœci'; ET_MISSING_WHITE_SPACE: ErrorStr2:= 'Brakuj¹cy znak spacji'; ET_MISSING_START_TAG: ErrorStr2:= 'Znacznik zamykaj¹cy bez znacznika otwieraj¹cego'; ET_MISSING_END_TAG: ErrorStr2:= 'Brakuj¹cy znacznik zamykaj¹cy'; ET_INVALID_CHARACTER: ErrorStr2:= 'Niew³aœciwy znak'; ET_NOT_IN_ROOT: ErrorStr2:= 'Znak(i) umieszczone poza zasiêgiem korzenia'; ET_INVALID_DOCTYPE: ErrorStr2:= 'Niew³aœciwa deklaracja typu dokumentu'; ET_WRONG_ORDER: ErrorStr2:= 'Niew³aœciwa kolejnoœæ'; ET_UNKNOWN_DECL_TYPE: ErrorStr2:= 'Nieznany typ deklaracji'; ET_INVALID_ENTITY_DECL: ErrorStr2:= 'Niew³aœciwa deklaracja encji'; ET_INVALID_ELEMENT_DECL: ErrorStr2:= 'Niew³aœciwa deklaracja elementu'; ET_INVALID_ATTRIBUTE_DECL: ErrorStr2:= 'Niew³aœciwa deklaracja atrybutu'; ET_INVALID_NOTATION_DECL: ErrorStr2:= 'Niew³aœciwa deklaracja notacji'; ET_INVALID_CONDITIONAL_SECTION: ErrorStr2:= 'Niew³aœciwa sekcja warunkowa'; ET_INVALID_TEXT_DECL: ErrorStr2:= 'Niew³aœciwa deklaracja tekstu'; ET_LT_IN_ATTRIBUTE_VALUE: ErrorStr2:= 'Znak ''<'' wystêpuj¹cy w zmienianej wartoœci atrybutu'; ET_ATTRIBUTE_VALUE_REFERS_TO_EXTERNAL_ENTITY: ErrorStr2:= 'Wartoœæ atrybutu odwo³uje siê do zewnêtrznej encji'; ET_RECURSIVE_REFERENCE: ErrorStr2:= 'ET_RECURSIVE_REFERENCE'; ET_REFERENCE_TO_UNPARSED_ENTITY: ErrorStr2:= 'Odwo³anie do encji, która nie by³a jeszcze parsowana'; ET_NO_PROPER_MARKUP_REFERENCED: ErrorStr2:= 'Odwo³anie do encji zawieraj¹cej niew³aœciwy znacznik'; ET_INVALID_COMMENT: ErrorStr2:= 'ET_INVALID_COMMENT'; ET_INVALID_CDATA_SECTION: ErrorStr2:= 'ET_INVALID_CDATA_SECTION'; ET_INVALID_SYSTEM_LITERAL: ErrorStr2:= 'ET_INVALID_SYSTEM_LITERAL'; ET_INVALID_PUBID_LITERAL: ErrorStr2:= 'ET_INVALID_PUBID_LITERAL'; ET_INVALID_QUALIFIED_NAME: ErrorStr2:= 'ET_INVALID_QUALIFIED_NAME'; ET_INVALID_PREFIX: ErrorStr2:= 'ET_INVALID_PREFIX'; ET_INVALID_NAMESPACE_URI: ErrorStr2:= 'ET_INVALID_NAMESPACE_URI'; ET_NAMESPACE_URI_NOT_FOUND: ErrorStr2:= 'ET_NAMESPACE_URI_NOT_FOUND'; ET_WRONG_PREFIX_MAPPING_NESTING: ErrorStr2:= 'ET_WRONG_PREFIX_MAPPING_NESTING'; ET_ENCODING_NOT_SUPPORTED: ErrorStr2:= 'ET_ENCODING_NOT_SUPPORTED'; ET_DOUBLE_ATTDEF: ErrorStr2:= 'Podwójna definicja atrybutu'; ET_DOUBLE_ENTITY_DECL: ErrorStr2:= 'Podwójna deklaracja encji'; ET_DOUBLE_PARAMETER_ENTITY_DECL: ErrorStr2:= 'Podwójna deklaracja encji parametrycznej'; ET_UNUSABLE_ENTITY_DECL: ErrorStr2:= 'Nieu¿ywana deklaracja encji'; ET_ENTITY_DECL_NOT_FOUND: ErrorStr2:= 'Brakuj¹ca deklaracja encji'; ET_DUPLICATE_ELEMENT_TYPE_DECL: ErrorStr2:= 'Podwójna deklaracja typu elementu'; ET_DUPLICATE_NAME_IN_MIXED_CONTENT: ErrorStr2:= 'Podwójna nazwa w mieszanej zawartoœci'; ET_DUPLICATE_ID_ON_ELEMENT_TYPE: ErrorStr2:= 'Zadeklarowany podwójny atrybut ID dla elementów tego samego typu'; ET_UNDECLARED_NOTATION_NAME: ErrorStr2:= 'Nie zadeklarowana nazwa notacji'; ET_DUPLICATE_NOTATION_ON_ELEMENT_TYPE: ErrorStr2:= 'Zadeklarowany podwójny atrybut notacji dla elementów tego samego typu'; ET_DUPLICATE_NOTATION_TOKEN: ErrorStr2:= 'ET_DUPLICATE_NOTATION_TOKEN'; ET_NOTATION_ON_EMPTY_ELEMENT: ErrorStr2:= 'Atrybut notacji zadeklarowany dla elementu typu pusty'; ET_DUPLICATE_ENUMERATION_TOKEN: ErrorStr2:= 'ET_DUPLICATE_ENUMERATION_TOKEN'; ET_ATTRIBUTE_TYPE_MISMATCH: ErrorStr2:= 'Typ atrybutu i wartoœæ atrybutu nie pasuj¹ do siebie'; ET_DUPLICATE_TOKENS: ErrorStr2:= 'Zadeklarowane dwa identyczne tokeny'; ET_ID_NEITHER_IMPLIED_NOR_REQUIRED: ErrorStr2:= 'Atrybut ID nie jest zadeklarowany ani jako #IMPLIED ani #REQUIRED'; ET_WRONG_ROOT_ELEMENT_TYPE: ErrorStr2:= 'Typ korzenia nie pasuje do nazwy z deklaracji typu dokumentu'; ET_ELEMENT_TYPE_DECL_NOT_FOUND: ErrorStr2:= 'Nie znaleziona deklaracja typu elementu'; ET_ELEMENT_DECLARED_EMPTY_HAS_CONTENT: ErrorStr2:= 'Element zadeklarowany jako EMPTY nie jest pusty'; ET_ELEMENT_WITH_ILLEGAL_MIXED_CONTENT: ErrorStr2:= 'Zawartoœæ elementu o mieszanej zawartoœci nie pasuje do deklaracji'; ET_ELEMENT_WITH_ILLEGAL_ELEMENT_CONTENT: ErrorStr2:= 'Zawartoœæ elementu, zawieraj¹cego element, nie pasuje do deklaracji'; ET_NONDETERMINISTIC_ELEMENT_CONTENT_MODEL: ErrorStr2:= 'Model zawartoœci elementu jest niedeterministyczny'; ET_DUPLICATE_NOTATION_DECL: ErrorStr2:= 'Podwójna deklaracja notacji'; ET_ATTRIBUTE_DEFINITION_NOT_FOUND: ErrorStr2:= 'Definicja atrybutu nie zosta³a znaleziona'; ET_REQUIRED_ATTRIBUTE_NOT_FOUND: ErrorStr2:= 'Wymagany atrybut nie zosta³ znaleziony'; ET_FIXED_ATTRIBUTE_MISMATCH: ErrorStr2:= 'Zadeklarowana i bie¿¹ca wartoœæ sta³ego atrybutu nie pasuja do siebie'; ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH: ErrorStr2:= 'Typ atrybutu i jego wartoœæ domyœlna nie pasuj¹ do siebie'; ET_DUPLICATE_ID_VALUE: ErrorStr2:= 'Podwójna wartoœæ ID'; ET_TARGET_ID_VALUE_NOT_FOUND: ErrorStr2:= 'Wartoœæ IDREF lub IDREFS odwo³uje siê do wartoœci ID nieistniej¹cego elementu'; ET_TARGET_UNPARSED_ENTITY_NOT_FOUND: ErrorStr2:= 'Wartoœæ ENTITY lub ENTITIES odwo³uje siê do niesparsowanej encji, która nie istnieje'; ET_WRONG_DECL_OF_PREDEFINED_ENTITY: ErrorStr2:= 'Niew³aœciwa deklaracja predefiniowanej encji'; ET_UNRESOLVABLE_ENTITY_REFERENCE: ErrorStr2:= 'Nierozwi¹zywalna referencja do encji'; ET_UNRESOLVABLE_PARAMETER_ENTITY_REFERENCE: ErrorStr2:= 'Nierozwi¹zywalna referencja encji parametrycznej'; ET_EXTERNAL_SUBSET_NOT_FOUND: ErrorStr2:= 'Zewnêtrzny podzbiór DTD nie zosta³ znaleziony'; ET_PARAMETER_ENTITY_DECL_NOT_FOUND: ErrorStr2:= 'ET_PARAMETER_ENTITY_DECL_NOT_FOUND'; else ErrorStr2:= 'Niew³aœciwy kod Ÿród³owy'; end; {case ...} result:= cp1250ToUTF16Str(concat(ErrorTypeStr,DocStr,ErrorStr1,' -- ',ErrorStr2)); end; function TdomError.getPortugueseErrorStr: wideString; // - This function was provided by Ricardo Albuquerque - var ErrorTypeStr,DocStr,ErrorStr1,ErrorStr2: string; begin case severity of DOM_SEVERITY_FATAL_ERROR: ErrorTypeStr:='ERRO FATAL '; DOM_SEVERITY_ERROR: ErrorTypeStr:='ERRO '; DOM_SEVERITY_WARNING: ErrorTypeStr:='ATENÇÃO: '; end; with FLocation do begin DocStr:= concat('no documento ',uri,' '); if lineNumber = -1 then ErrorStr1:= '' else if startLineNumber = lineNumber then begin if startColumnNumber = columnNumber then FmtStr(ErrorStr1,'na linha %d, posição %d',[lineNumber,columnNumber]) else FmtStr(ErrorStr1,'na linha %d, entre posição %d e %d',[lineNumber,startColumnNumber,columnNumber]); end else begin FmtStr(ErrorStr1,'entre linha %d, posição %d e linha %d, posição %d',[startLineNumber,startColumnNumber,lineNumber,columnNumber]); end; end; case FRelatedException of ET_INVALID_ELEMENT_NAME: ErrorStr2:= 'Nome de elemento inválido'; ET_DOUBLE_ROOT_ELEMENT: ErrorStr2:= 'Elemento raiz duplicado'; ET_DOUBLE_DOCTYPE: ErrorStr2:= 'Definição de tipo de documento(DTD) duplicado'; ET_INVALID_ATTRIBUTE_NAME: ErrorStr2:= 'Nome de atributo inválido'; ET_INVALID_ATTRIBUTE_VALUE: ErrorStr2:= 'valor de atributo inválido'; ET_DOUBLE_ATTRIBUTE_NAME: ErrorStr2:= 'Nome de atributo duplicado em um elemento'; ET_INVALID_ENTITY_NAME: ErrorStr2:= 'Nome de entidade inválida'; ET_INVALID_PROCESSING_INSTRUCTION: ErrorStr2:= 'Instrução de processamento inválida'; ET_INVALID_XML_DECL: ErrorStr2:= 'Declaração XML inválida'; ET_INVALID_CHARREF: ErrorStr2:= 'Referência a caracter invalida'; ET_MISSING_QUOTATION_MARK: ErrorStr2:= 'Aspas faltando'; ET_MISSING_EQUALITY_SIGN: ErrorStr2:= 'Sinal de igualdade faltando'; ET_DOUBLE_EQUALITY_SIGN: ErrorStr2:= 'Sinal de igualdade duplicado'; ET_MISSING_WHITE_SPACE: ErrorStr2:= 'Espaço em branco faltando'; ET_MISSING_START_TAG: ErrorStr2:= 'Marca de fim sem marca de início '; ET_MISSING_END_TAG: ErrorStr2:= 'Marca de fim faltando'; ET_INVALID_CHARACTER: ErrorStr2:= 'Caracter inválido'; ET_NOT_IN_ROOT: ErrorStr2:= 'Caracter(es) fora do elemento raiz'; ET_INVALID_DOCTYPE: ErrorStr2:= 'Declaração de tipo de documento inválida'; ET_WRONG_ORDER: ErrorStr2:= 'Ordem errada'; ET_UNKNOWN_DECL_TYPE: ErrorStr2:= 'Tipo de declaração inválida'; ET_INVALID_ENTITY_DECL: ErrorStr2:= 'Declaração de entidade inválida'; ET_INVALID_ELEMENT_DECL: ErrorStr2:= 'Declaração de elemento inválido'; ET_INVALID_ATTRIBUTE_DECL: ErrorStr2:= 'Declaração de atributo inválido'; ET_INVALID_NOTATION_DECL: ErrorStr2:= 'Declaração de notação inválida'; ET_INVALID_CONDITIONAL_SECTION: ErrorStr2:= 'Seção condicional inválida'; ET_INVALID_TEXT_DECL: ErrorStr2:= 'Declaração de texto inválido'; ET_LT_IN_ATTRIBUTE_VALUE: ErrorStr2:= 'Encontrado o caracter ''<'' no valor do atributo'; ET_ATTRIBUTE_VALUE_REFERS_TO_EXTERNAL_ENTITY: ErrorStr2:= 'O valor do atributo se refere a uma entidade externa'; ET_RECURSIVE_REFERENCE: ErrorStr2:= 'ET_RECURSIVE_REFERENCE'; ET_REFERENCE_TO_UNPARSED_ENTITY: ErrorStr2:= 'Referência a uma entidade não analisada'; ET_NO_PROPER_MARKUP_REFERENCED: ErrorStr2:= 'Referência a uma entidade contendo marcação imprópria'; ET_INVALID_COMMENT: ErrorStr2:= 'ET_INVALID_COMMENT'; ET_INVALID_CDATA_SECTION: ErrorStr2:= 'ET_INVALID_CDATA_SECTION'; ET_INVALID_SYSTEM_LITERAL: ErrorStr2:= 'ET_INVALID_SYSTEM_LITERAL'; ET_INVALID_PUBID_LITERAL: ErrorStr2:= 'ET_INVALID_PUBID_LITERAL'; ET_INVALID_QUALIFIED_NAME: ErrorStr2:= 'ET_INVALID_QUALIFIED_NAME'; ET_INVALID_PREFIX: ErrorStr2:= 'ET_INVALID_PREFIX'; ET_INVALID_NAMESPACE_URI: ErrorStr2:= 'ET_INVALID_NAMESPACE_URI'; ET_NAMESPACE_URI_NOT_FOUND: ErrorStr2:= 'ET_NAMESPACE_URI_NOT_FOUND'; ET_WRONG_PREFIX_MAPPING_NESTING: ErrorStr2:= 'ET_WRONG_PREFIX_MAPPING_NESTING'; ET_ENCODING_NOT_SUPPORTED: ErrorStr2:= 'ET_ENCODING_NOT_SUPPORTED'; ET_DOUBLE_ATTDEF: ErrorStr2:= 'Definição de atributo duplicada'; ET_DOUBLE_ENTITY_DECL: ErrorStr2:= 'Declaração de entidade duplicada'; ET_DOUBLE_PARAMETER_ENTITY_DECL: ErrorStr2:= 'Declaração de entidade paramétrica duplicada'; ET_UNUSABLE_ENTITY_DECL: ErrorStr2:= 'Entidade inutilizável declarada'; ET_ENTITY_DECL_NOT_FOUND: ErrorStr2:= 'Faltando declaração de entidade'; ET_DUPLICATE_ELEMENT_TYPE_DECL: ErrorStr2:= 'Declaração do tipo do elemento duplicada'; ET_DUPLICATE_NAME_IN_MIXED_CONTENT: ErrorStr2:= 'Nome duplicado no conteúdo misto'; ET_DUPLICATE_ID_ON_ELEMENT_TYPE: ErrorStr2:= 'Atributo ID duplicado na mesma declaração de tipo de elemento'; ET_UNDECLARED_NOTATION_NAME: ErrorStr2:= 'Nome de anotação não declarado'; ET_DUPLICATE_NOTATION_ON_ELEMENT_TYPE: ErrorStr2:= 'Atributo de Anotação duplicado na mesma declaração de tipo de elemento'; ET_DUPLICATE_NOTATION_TOKEN: ErrorStr2:= 'ET_DUPLICATE_NOTATION_TOKEN'; ET_NOTATION_ON_EMPTY_ELEMENT: ErrorStr2:= 'Atributo de anotação em uma declaração de tipo de elemento vazia'; ET_DUPLICATE_ENUMERATION_TOKEN: ErrorStr2:= 'ET_DUPLICATE_ENUMERATION_TOKEN'; ET_ATTRIBUTE_TYPE_MISMATCH: ErrorStr2:= 'Tipo de atributo e valor de atributo não coincidem'; ET_DUPLICATE_TOKENS: ErrorStr2:= 'Declaração de ''tokens'' duplicada'; ET_ID_NEITHER_IMPLIED_NOR_REQUIRED: ErrorStr2:= 'Atributo ID não foi declarado como #IMPLIED nem como #REQUIRED'; ET_WRONG_ROOT_ELEMENT_TYPE: ErrorStr2:= 'O tipo de elemento raiz não tem o mesmo nome que a declaração do tipo de documento'; ET_ELEMENT_TYPE_DECL_NOT_FOUND: ErrorStr2:= 'Declaração de tipo de elemento não encontrada'; ET_ELEMENT_DECLARED_EMPTY_HAS_CONTENT: ErrorStr2:= 'Elemento declarado como ''EMPTY'' não está vazio'; ET_ELEMENT_WITH_ILLEGAL_MIXED_CONTENT: ErrorStr2:= 'O conteúdo de um elemento com conteúdo misto não coincide com sua declaração'; ET_ELEMENT_WITH_ILLEGAL_ELEMENT_CONTENT: ErrorStr2:= 'O conteúdo de um elemento com conteúdo de elemento não coincide com sua declaração'; ET_NONDETERMINISTIC_ELEMENT_CONTENT_MODEL: ErrorStr2:= 'O modelo de conteúdo de um elemento não é determinante'; ET_DUPLICATE_NOTATION_DECL: ErrorStr2:= 'Declaração de anotação duplicada'; ET_ATTRIBUTE_DEFINITION_NOT_FOUND: ErrorStr2:= 'Definição de atributo não encontrada'; ET_REQUIRED_ATTRIBUTE_NOT_FOUND: ErrorStr2:= 'Atributo requerido não encontrado'; ET_FIXED_ATTRIBUTE_MISMATCH: ErrorStr2:= 'O valor declarado e o valor atual de um atributo fixo não coincidem'; ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH: ErrorStr2:= 'O tipo de atributo e o atributo por definição não coincidem'; ET_DUPLICATE_ID_VALUE: ErrorStr2:= 'Valor de ID duplicado'; ET_TARGET_ID_VALUE_NOT_FOUND: ErrorStr2:= 'O valor de IDREF ou IDREFS se refere a um valor de ID não existente'; ET_TARGET_UNPARSED_ENTITY_NOT_FOUND: ErrorStr2:= 'O valor de ENTITY ou ENTITIES se refere a uma entidade não existente'; ET_WRONG_DECL_OF_PREDEFINED_ENTITY: ErrorStr2:= 'Declaração errônea de uma entidade pré-definida'; ET_UNRESOLVABLE_ENTITY_REFERENCE: ErrorStr2:= 'Referência a entidade impossível de resolver'; ET_EXTERNAL_SUBSET_NOT_FOUND: ErrorStr2:= 'ET_EXTERNAL_SUBSET_NOT_FOUND'; ET_PARAMETER_ENTITY_DECL_NOT_FOUND: ErrorStr2:= 'ET_PARAMETER_ENTITY_DECL_NOT_FOUND'; else ErrorStr2:= 'Código fonte inválido'; end; {case ...} result:= Iso8859_1ToUTF16Str(concat(ErrorTypeStr,DocStr,ErrorStr1,' -- ',ErrorStr2)); end; function TdomError.getSpanishErrorStr: wideString; // - This function was provided by Pedro de Paz - var ErrorTypeStr,DocStr,ErrorStr1,ErrorStr2: string; begin case severity of DOM_SEVERITY_FATAL_ERROR: ErrorTypeStr:='ERROR FATAL '; DOM_SEVERITY_ERROR: ErrorTypeStr:='ERROR '; DOM_SEVERITY_WARNING: ErrorTypeStr:='AVISO: '; end; with FLocation do begin DocStr:= concat('en el documento ',uri,' '); if lineNumber = -1 then ErrorStr1:= '' else if startLineNumber = lineNumber then begin if startColumnNumber = columnNumber then FmtStr(ErrorStr1,'en la linea %d, posición %d',[lineNumber,columnNumber]) else FmtStr(ErrorStr1,'en la linea %d, entre las posiciones %d y %d',[lineNumber,startColumnNumber,columnNumber]); end else begin FmtStr(ErrorStr1,'entre la linea %d, posición %d y la linea %d, posición %d',[startLineNumber,startColumnNumber,lineNumber,columnNumber]); end; end; case FRelatedException of ET_INVALID_ELEMENT_NAME: ErrorStr2:= 'Nombre de elemento no válido'; ET_DOUBLE_ROOT_ELEMENT: ErrorStr2:= 'Elemento raiz duplicado'; ET_DOUBLE_DOCTYPE: ErrorStr2:= 'Declaración de tipo de documento (DTD) duplicada'; ET_INVALID_ATTRIBUTE_NAME: ErrorStr2:= 'Nombre de atributo no válido'; ET_INVALID_ATTRIBUTE_VALUE: ErrorStr2:= 'Valor de atributo no válido'; ET_DOUBLE_ATTRIBUTE_NAME: ErrorStr2:= 'Atributo duplicado en un elemento'; ET_INVALID_ENTITY_NAME: ErrorStr2:= 'Nombre de entidad no válida'; ET_INVALID_PROCESSING_INSTRUCTION: ErrorStr2:= 'Instrucción de proceso no válida'; ET_INVALID_XML_DECL: ErrorStr2:= 'Declaración XML no válida'; ET_INVALID_CHARREF: ErrorStr2:= 'Referencia a caracter no válida'; ET_MISSING_QUOTATION_MARK: ErrorStr2:= 'No se encontraron comillas'; ET_MISSING_EQUALITY_SIGN: ErrorStr2:= 'No se encontró simbolo de igualdad'; ET_DOUBLE_EQUALITY_SIGN: ErrorStr2:= 'Signo de igualdad duplicado'; ET_MISSING_WHITE_SPACE: ErrorStr2:= 'No se encontró espacio en blanco'; ET_MISSING_START_TAG: ErrorStr2:= 'Tag final sin tag de inicio'; ET_MISSING_END_TAG: ErrorStr2:= 'Tag de inicio sin tag final'; ET_INVALID_CHARACTER: ErrorStr2:= 'Caracter no válido'; ET_NOT_IN_ROOT: ErrorStr2:= 'Caracter(es) fuera del elemento raiz'; ET_INVALID_DOCTYPE: ErrorStr2:= 'Declaración de tipo de documento no válida'; ET_WRONG_ORDER: ErrorStr2:= 'Orden equivocado'; ET_UNKNOWN_DECL_TYPE: ErrorStr2:= 'Tipo de declaración desconocida'; ET_INVALID_ENTITY_DECL: ErrorStr2:= 'Declaración de entidad no válida'; ET_INVALID_ELEMENT_DECL: ErrorStr2:= 'Declaración de elemento no válida'; ET_INVALID_ATTRIBUTE_DECL: ErrorStr2:= 'Declaración de atributo no válida'; ET_INVALID_NOTATION_DECL: ErrorStr2:= 'Declaración de anotación no válida'; ET_INVALID_CONDITIONAL_SECTION: ErrorStr2:= 'Sección condicional no válida'; ET_INVALID_TEXT_DECL: ErrorStr2:= 'Declaración de texto no válida'; ET_LT_IN_ATTRIBUTE_VALUE: ErrorStr2:= 'Encontrado caracter ''<'' en valor de atributo'; ET_ATTRIBUTE_VALUE_REFERS_TO_EXTERNAL_ENTITY: ErrorStr2:= 'Valor de atributo apuntando a una entidad externa'; ET_RECURSIVE_REFERENCE: ErrorStr2:= 'ET_RECURSIVE_REFERENCE'; ET_REFERENCE_TO_UNPARSED_ENTITY: ErrorStr2:= 'Referencia a una entidad no analizada'; ET_NO_PROPER_MARKUP_REFERENCED: ErrorStr2:= 'Referencia a una entidad que contiene un ''markup'' no adecuado'; ET_INVALID_COMMENT: ErrorStr2:= 'ET_INVALID_COMMENT'; ET_INVALID_CDATA_SECTION: ErrorStr2:= 'ET_INVALID_CDATA_SECTION'; ET_INVALID_SYSTEM_LITERAL: ErrorStr2:= 'ET_INVALID_SYSTEM_LITERAL'; ET_INVALID_PUBID_LITERAL: ErrorStr2:= 'ET_INVALID_PUBID_LITERAL'; ET_INVALID_QUALIFIED_NAME: ErrorStr2:= 'ET_INVALID_QUALIFIED_NAME'; ET_INVALID_PREFIX: ErrorStr2:= 'ET_INVALID_PREFIX'; ET_INVALID_NAMESPACE_URI: ErrorStr2:= 'ET_INVALID_NAMESPACE_URI'; ET_NAMESPACE_URI_NOT_FOUND: ErrorStr2:= 'ET_NAMESPACE_URI_NOT_FOUND'; ET_WRONG_PREFIX_MAPPING_NESTING: ErrorStr2:= 'ET_WRONG_PREFIX_MAPPING_NESTING'; ET_ENCODING_NOT_SUPPORTED: ErrorStr2:= 'ET_ENCODING_NOT_SUPPORTED'; ET_DOUBLE_ATTDEF: ErrorStr2:= 'Definición de atributo duplicada'; ET_DOUBLE_ENTITY_DECL: ErrorStr2:= 'Declaración de entidad duplicada'; ET_DOUBLE_PARAMETER_ENTITY_DECL: ErrorStr2:= 'Declaración de entidad con parametros duplicados'; ET_UNUSABLE_ENTITY_DECL: ErrorStr2:= 'Declaración de entidad no utilizable'; ET_ENTITY_DECL_NOT_FOUND: ErrorStr2:= 'No existe declaración de entidad'; ET_DUPLICATE_ELEMENT_TYPE_DECL: ErrorStr2:= 'Duplicada declaración de tipo de elemento'; ET_DUPLICATE_NAME_IN_MIXED_CONTENT: ErrorStr2:= 'Nombre duplicado en contenido mezclado'; ET_DUPLICATE_ID_ON_ELEMENT_TYPE: ErrorStr2:= 'Atributo ID duplicado en la misma declaración de tipo de elemento'; ET_UNDECLARED_NOTATION_NAME: ErrorStr2:= 'Nombre de anotación no declarado'; ET_DUPLICATE_NOTATION_ON_ELEMENT_TYPE: ErrorStr2:= 'Atributo de anotación duplicado en la misma declaración de tipo de elemento'; ET_DUPLICATE_NOTATION_TOKEN: ErrorStr2:= 'ET_DUPLICATE_NOTATION_TOKEN'; ET_NOTATION_ON_EMPTY_ELEMENT: ErrorStr2:= 'Atributo de anotación en una declaración de tipo de elemento vacia'; ET_DUPLICATE_ENUMERATION_TOKEN: ErrorStr2:= 'ET_DUPLICATE_ENUMERATION_TOKEN'; ET_ATTRIBUTE_TYPE_MISMATCH: ErrorStr2:= 'Tipo de atributo y valor de atributo no coinciden'; ET_DUPLICATE_TOKENS: ErrorStr2:= 'Declaración de ''tokens'' duplicada'; ET_ID_NEITHER_IMPLIED_NOR_REQUIRED: ErrorStr2:= 'Atributo ID no ha sido declarado como #IMPLIED ni como #REQUIRED'; ET_WRONG_ROOT_ELEMENT_TYPE: ErrorStr2:= 'El tipo del elemento raiz no tiene el mismo nombre que la declaración del tipo de documento'; ET_ELEMENT_TYPE_DECL_NOT_FOUND: ErrorStr2:= 'Declaración de tipo de elemento no encontrada'; ET_ELEMENT_DECLARED_EMPTY_HAS_CONTENT: ErrorStr2:= 'Elemento declarado como ''EMPTY'' no esta vacio'; ET_ELEMENT_WITH_ILLEGAL_MIXED_CONTENT: ErrorStr2:= 'El contenido de un elemento con contenido mezclado no coincide con su declaración'; ET_ELEMENT_WITH_ILLEGAL_ELEMENT_CONTENT: ErrorStr2:= 'El contenido de un elemento con contenido de elemento no coincide con su declaración'; ET_NONDETERMINISTIC_ELEMENT_CONTENT_MODEL: ErrorStr2:= 'El modelo de contenido de un elemento no es determinante'; ET_DUPLICATE_NOTATION_DECL: ErrorStr2:= 'Declaración de anotación duplicada'; ET_ATTRIBUTE_DEFINITION_NOT_FOUND: ErrorStr2:= 'Definición de atributo no encontrada'; ET_REQUIRED_ATTRIBUTE_NOT_FOUND: ErrorStr2:= 'Atributo requerido no encontrado'; ET_FIXED_ATTRIBUTE_MISMATCH: ErrorStr2:= 'El valor declarado y el valor actual de un atributo fijo no coincide'; ET_ATTRIBUTE_DEFAULT_TYPE_MISMATCH: ErrorStr2:= 'El tipo de atributo y el atributo por defecto no coincide'; ET_DUPLICATE_ID_VALUE: ErrorStr2:= 'Valor de ID duplicado'; ET_TARGET_ID_VALUE_NOT_FOUND: ErrorStr2:= 'El valor de IDREF o IDREFS apunta a un valor de ID no existente'; ET_TARGET_UNPARSED_ENTITY_NOT_FOUND: ErrorStr2:= 'El valor de ENTITY o ENTITIES apunta a una entidad no existente'; ET_WRONG_DECL_OF_PREDEFINED_ENTITY: ErrorStr2:= 'DEclaración erronea de una entidad predefinida'; ET_UNRESOLVABLE_ENTITY_REFERENCE: ErrorStr2:= 'Referencia a entidad imposible de resolver'; ET_EXTERNAL_SUBSET_NOT_FOUND: ErrorStr2:= 'ET_EXTERNAL_SUBSET_NOT_FOUND'; ET_PARAMETER_ENTITY_DECL_NOT_FOUND: ErrorStr2:= 'ET_PARAMETER_ENTITY_DECL_NOT_FOUND'; else ErrorStr2:= 'Codigo fuente no válido'; end; {case ...} result:= Iso8859_1ToUTF16Str(concat(ErrorTypeStr,DocStr,ErrorStr1,' -- ',ErrorStr2)); end; procedure TdomError.setLanguage(const value: TIso639LanguageCode); begin if not (value in FSupportedLanguages) then raise ENot_Supported_Err.create('Not supported error.'); FLanguage:= value; end; function TdomError.getMessage: wideString; begin Result:= ''; case FLanguage of iso639_de: result:= getGermanErrorStr; iso639_en: result:= getEnglishErrorStr; iso639_es: result:= getSpanishErrorStr; iso639_fr: result:= getFrenchErrorStr; iso639_it: result:= getItalianErrorStr; iso639_nl: result:= getDutchErrorStr; iso639_pl: result:= getPolishErrorStr; iso639_pt: result:= getPortugueseErrorStr; else exit; end; if FCode = '' then Result:= concat(Result,'.') else Result:= concat(Result,': ',FCode); end; // ++++++++++++++++++++++++ TdomLocator ++++++++++++++++++++++++ constructor TdomLocator.create(const startLine, startColumn, endLine, endColumn, offset: integer; const uri: wideString; const rCMNode: TdomCMNode; const rNode: TdomNode); begin inherited create; FStartLineNumber:= startLine; FStartColumnNumber:= startColumn; FLineNumber:= endLine; FColumnNumber:= endColumn; FOffset:= offset; FUri:= uri; FRelatedCMNode:= rCMNode; FRelatedNode:= rNode; end; function TdomLocator.getColumnNumber: integer; begin Result:= FColumnNumber; end; function TdomLocator.getLineNumber: integer; begin Result:= FLineNumber; end; function TdomLocator.getOffset: integer; begin Result:= FOffset; end; function TdomLocator.getRelatedCMNode: TdomCMNode; begin Result:= FRelatedCMNode; end; function TdomLocator.getRelatedNode: TdomNode; begin Result:= FRelatedNode; end; function TdomLocator.getStartColumnNumber: integer; begin Result:= FStartColumnNumber; end; function TdomLocator.getStartLineNumber: integer; begin Result:= FStartLineNumber; end; function TdomLocator.getUri: wideString; begin Result:= FUri; end; // ++++++++++++++++++++ TdomInputSourceLocator ++++++++++++++++++++ constructor TdomInputSourceLocator.create(const inputSource: TXmlInputSource; const startLine, startColumn, endLine, endColumn, tabWidthValue: integer); begin inherited create(startLine,startColumn,endLine,endColumn,-1,'',nil,nil); FInputSource:= inputSource; FTabWidth:= tabWidthValue; end; function TdomInputSourceLocator.getOffset: integer; begin Result:= -1; if assigned(FInputSource) then with FInputSource do if assigned(stream) then result:= stream.Position; end; function TdomInputSourceLocator.getUri: wideString; begin if assigned(FInputSource) then result:= FInputSource.systemId else result:= ''; end; procedure TdomInputSourceLocator.evaluate(const s: WideChar); const TAB: WideChar = #9; LF: WideChar = #10; begin if s = LF then begin inc(FLineNumber); FColumnNumber:= 0; end else if s = TAB then begin inc(FColumnNumber,tabWidth); end else inc(FColumnNumber); end; procedure TdomInputSourceLocator.setStartMark; begin FStartColumnNumber:= FColumnNumber; FStartLineNumber:= FLineNumber; end; // ++++++++++++++++++++++++++++ TXmlCustomHandler ++++++++++++++++++++++++++++ function TXmlCustomHandler.sendErrorNotification(const target: TXmlCustomReader; const xmlErrorType: TXmlErrorType; const location: TdomLocator; const code: wideString): boolean; begin if assigned(target) then begin result:= target.sendErrorNotification(xmlErrorType,location,code); end else begin if xmlErrorType in ET_FATAL_ERRORS then result:= false else result:= true; end; end; // +++++++++++++++++++++++++++ TXmlStandardHandler +++++++++++++++++++++++++++ procedure TXmlStandardHandler.Notification(AComponent: TComponent; operation: TOperation); begin inherited notification(AComponent,Operation); if (Operation = opRemove) and (AComponent = FNextHandler) then FNextHandler:= nil; end; function TXmlStandardHandler.CDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; begin if assigned(FOnCDATA) then FOnCDATA(sender,locator,data); if assigned(nextHandler) then result:= nextHandler.CDATA(sender,locator,data) else result:= true; end; function TXmlStandardHandler.charRef(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; begin if assigned(FOnCharRef) then FOnCharRef(sender,locator,data); if assigned(nextHandler) then result:= nextHandler.charRef(sender,locator,data) else result:= true; end; function TXmlStandardHandler.comment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; begin if assigned(FOnComment) then FOnComment(sender,locator,data); if assigned(nextHandler) then result:= nextHandler.comment(sender,locator,data) else result:= true; end; function TXmlStandardHandler.doctype(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId, data: wideString): boolean; begin if assigned(FOnDoctype) then FOnDoctype(sender,locator,aname,pubId,sysId,data); if assigned(nextHandler) then result:= nextHandler.doctype(sender,locator,aname,pubId,sysId,data) else result:= true; end; function TXmlStandardHandler.endDocument(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnEndDocument) then FOnEndDocument(sender,locator); if assigned(nextHandler) then result:= nextHandler.endDocument(sender,locator) else result:= true; end; function TXmlStandardHandler.endElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString): boolean; begin if assigned(FOnEndElement) then FOnEndElement(sender,locator,namespaceURI,tagName); if assigned(nextHandler) then result:= nextHandler.endElement(sender,locator,namespaceURI,tagName) else result:= true; end; function TXmlStandardHandler.endPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix: wideString): boolean; begin if assigned(FOnEndPrefixMapping) then FOnEndPrefixMapping(sender,locator,prefix); if assigned(nextHandler) then result:= nextHandler.endPrefixMapping(sender,locator,prefix) else result:= true; end; function TXmlStandardHandler.entityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; begin if assigned(FOnEntityRef) then FOnEntityRef(sender,locator,aname); if assigned(nextHandler) then result:= nextHandler.entityRef(sender,locator,aname) else result:= true; end; function TXmlStandardHandler.PCDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; begin if assigned(FOnPCDATA) then FOnPCDATA(sender,locator,data); if assigned(nextHandler) then result:= nextHandler.PCDATA(sender,locator,data) else result:= true; end; function TXmlStandardHandler.processingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; begin if assigned(FOnProcessingInstruction) then FOnProcessingInstruction(sender,locator,targ,data); if assigned(nextHandler) then result:= nextHandler.processingInstruction(sender,locator,targ,data) else result:= true; end; function TXmlStandardHandler.skippedEntity(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; begin if assigned(FOnSkippedEntity) then FOnSkippedEntity(sender,locator,aname); if assigned(nextHandler) then result:= nextHandler.skippedEntity(sender,locator,aname) else result:= true; end; function TXmlStandardHandler.startDocument(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString; sdDl: TdomStandalone): boolean; begin if assigned(FOnStartDocument) then FOnStartDocument(sender,locator,version,encName,sdDl); if assigned(nextHandler) then result:= nextHandler.startDocument(sender,locator,version,encName,sdDl) else result:= true; end; function TXmlStandardHandler.startElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString; attributes: TdomNameValueList): boolean; begin if assigned(FOnStartElement) then FOnStartElement(sender,locator,namespaceURI,tagName,attributes); if assigned(nextHandler) then result:= nextHandler.startElement(sender,locator,namespaceURI,tagName,attributes) else result:= true; end; function TXmlStandardHandler.startPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix, uri: wideString): boolean; begin if assigned(FOnStartPrefixMapping) then FOnStartPrefixMapping(sender,locator,prefix,uri); if assigned(nextHandler) then result:= nextHandler.startPrefixMapping(sender,locator,prefix,uri) else result:= true; end; function TXmlStandardHandler.attributeDefinition(const sender: TXmlCustomReader; const locator: TdomLocator; aname, attType, bracket, defaultDecl, attValue: wideString): boolean; begin if assigned(FOnAttributeDefinition) then FOnAttributeDefinition(sender,locator,aname,attType,bracket,defaultDecl,attValue); if assigned(nextHandler) then result:= nextHandler.attributeDefinition(sender,locator,aname,attType,bracket,defaultDecl,attValue) else result:= true; end; function TXmlStandardHandler.conditionalSection(const sender: TXmlCustomReader; const locator: TdomLocator; includeStmt, data: wideString): boolean; begin if assigned(FOnConditionalSection) then FOnConditionalSection(sender,locator,includeStmt,data); if assigned(nextHandler) then result:= nextHandler.conditionalSection(sender,locator,includeStmt,data) else result:= true; end; function TXmlStandardHandler.DTDcomment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; begin if assigned(FOnDtdComment) then FOnDtdComment(sender,locator,data); if assigned(nextHandler) then result:= nextHandler.DTDcomment(sender,locator,data) else result:= true; end; function TXmlStandardHandler.DTDprocessingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; begin if assigned(FOnDtdProcessingInstruction) then FOnDtdProcessingInstruction(sender,locator,targ,data); if assigned(nextHandler) then result:= nextHandler.DTDprocessingInstruction(sender,locator,targ,data) else result:= true; end; function TXmlStandardHandler.elementTypeDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, data: wideString): boolean; begin if assigned(FOnElementTypeDeclaration) then FOnElementTypeDeclaration(sender,locator,aname,data); if assigned(nextHandler) then result:= nextHandler.elementTypeDeclaration(sender,locator,aname,data) else result:= true; end; function TXmlStandardHandler.endAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnEndAttListDeclaration) then FOnEndAttListDeclaration(sender,locator); if assigned(nextHandler) then result:= nextHandler.endAttListDeclaration(sender,locator) else result:= true; end; function TXmlStandardHandler.endExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnEndExtDtd) then FOnEndExtDtd(sender,locator); if assigned(nextHandler) then result:= nextHandler.endExtDtd(sender,locator) else result:= true; end; function TXmlStandardHandler.endIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnendIntDtd) then FOnendIntDtd(sender,locator); if assigned(nextHandler) then result:= nextHandler.endIntDtd(sender,locator) else result:= true; end; function TXmlStandardHandler.entityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId, notaName: wideString): boolean; begin if assigned(FOnEntityDeclaration) then FOnEntityDeclaration(sender,locator,aname,entityValue,pubId,sysId,notaName); if assigned(nextHandler) then result:= nextHandler.entityDeclaration(sender,locator,aname,entityValue,pubId,sysId,notaName) else result:= true; end; function TXmlStandardHandler.notationDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId: wideString): boolean; begin if assigned(FOnNotationDeclaration) then FOnNotationDeclaration(sender,locator,aname,pubId,sysId); if assigned(nextHandler) then result:= nextHandler.notationDeclaration(sender,locator,aname,pubId,sysId) else result:= true; end; function TXmlStandardHandler.parameterEntityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId: wideString): boolean; begin if assigned(FOnParameterEntityDeclaration) then FOnParameterEntityDeclaration(sender,locator,aname,entityValue,pubId,sysId); if assigned(nextHandler) then result:= nextHandler.parameterEntityDeclaration(sender,locator,aname,entityValue,pubId,sysId) else result:= true; end; function TXmlStandardHandler.parameterEntityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; begin if assigned(FOnParameterEntityRef) then FOnParameterEntityRef(sender,locator,aname); if assigned(nextHandler) then result:= nextHandler.parameterEntityRef(sender,locator,aname) else result:= true; end; function TXmlStandardHandler.startAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; begin if assigned(FOnStartAttListDeclaration) then FOnStartAttListDeclaration(sender,locator,aname); if assigned(nextHandler) then result:= nextHandler.startAttListDeclaration(sender,locator,aname) else result:= true; end; function TXmlStandardHandler.startExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString): boolean; begin if assigned(FOnstartExtDtd) then FOnstartExtDtd(sender,locator,version,encName); if assigned(nextHandler) then result:= nextHandler.startExtDtd(sender,locator,version,encName) else result:= true; end; function TXmlStandardHandler.startIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnstartIntDtd) then FOnstartIntDtd(sender,locator); if assigned(nextHandler) then result:= nextHandler.startIntDtd(sender,locator) else result:= true; end; function TXmlStandardHandler.resolvePE( PEReferenceName: wideString; var PEValue: wideString; var error: TXmlErrorType): boolean; begin if assigned(nextHandler) then result:= nextHandler.resolvePE(PEReferenceName,PEValue,error) else begin PEValue:= ''; error:= ET_UNRESOLVABLE_PARAMETER_ENTITY_REFERENCE; result:= true; end; end; procedure TXmlStandardHandler.notifyReset; begin if assigned(nextHandler) then nextHandler.notifyReset; end; // +++++++++++++++++++++++++++++ TXmlHandlerItem +++++++++++++++++++++++++++++ function TXmlHandlerItem.getXmlHandler: TXmlCustomHandler; begin Result := FXmlHandler; end; procedure TXmlHandlerItem.setXmlHandler(Value: TXmlCustomHandler); begin FXmlHandler:= Value; end; procedure TXmlHandlerItem.Assign(Source: TPersistent); begin if Source is TXmlHandlerItem then XmlHandler:= TXmlHandlerItem(Source).XmlHandler else inherited Assign(Source); end; // +++++++++++++++++++++++++++++++ TXmlHandlers ++++++++++++++++++++++++++++++ constructor TXmlHandlers.Create(Distributor: TXmlDistributor); begin inherited create(TXmlHandlerItem); FDistributor:= Distributor; end; function TXmlHandlers.GetItem(Index: Integer): TXmlHandlerItem; begin result:= TXmlHandlerItem(inherited GetItem(Index)); end; procedure TXmlHandlers.SetItem(Index: Integer; Value: TXmlHandlerItem); begin inherited SetItem(Index, Value); end; function TXmlHandlers.GetOwner: TPersistent; begin result:= FDistributor; end; function TXmlHandlers.Add: TXmlHandlerItem; begin result:= TXmlHandlerItem(inherited Add); end; procedure TXmlHandlers.Assign(Source: TPersistent); var i: integer; begin if Source = self then exit; if Source is TStrings then begin clear; with TStrings(Source) do for i:= 0 to pred(count) do if assigned(Objects[i]) then if Objects[i] is TXmlCustomHandler then self.add.XmlHandler:= TXmlCustomHandler(Objects[i]); end else inherited Assign(Source); end; function TXmlHandlers.FindHandlerItem(AHandler: TXmlCustomHandler): TXmlHandlerItem; var i: integer; begin for i:= 0 to pred(count) do begin result := TXmlHandlerItem(inherited getItem(i)); if result.FXmlHandler = AHandler then exit; end; result:= nil; end; // +++++++++++++++++++++++++++++ TXmlDistributor +++++++++++++++++++++++++++++ constructor TXmlDistributor.create(AOwner: TComponent); begin inherited create(AOwner); FNextHandlers:= TXmlHandlers.create(self); end; destructor TXmlDistributor.destroy; begin FNextHandlers.free; inherited destroy; end; procedure TXmlDistributor.readData(Reader: TReader); begin Reader.ReadCollection(nextHandlers); end; procedure TXmlDistributor.writeData(Writer: TWriter); begin Writer.WriteCollection(nextHandlers); end; procedure TXmlDistributor.DefineProperties(Filer: TFiler); begin inherited DefineProperties(Filer); Filer.DefineProperty('NextHandlers',readData,writeData,true); end; procedure TXmlDistributor.Notification(AComponent: TComponent; operation: TOperation); var handlerItem: TXmlHandlerItem; begin inherited notification(AComponent,Operation); if not (csDestroying in ComponentState) and (Operation = opRemove) then begin if (AComponent is TXmlCustomHandler) then begin handlerItem := nextHandlers.FindHandlerItem(TXmlCustomHandler(AComponent)); if handlerItem <> nil then handlerItem.XmlHandler:= nil; end; end; end; procedure TXmlDistributor.setNextHandlers(const value: TXmlHandlers); begin FNextHandlers.Assign(Value); end; function TXmlDistributor.CDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; var i: integer; begin if assigned(FOnCDATA) then FOnCDATA(sender,locator,data); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.CDATA(sender,locator,data); if not result then break; end; end; end; function TXmlDistributor.charRef(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; var i: integer; begin if assigned(FOnCharRef) then FOnCharRef(sender,locator,data); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.charRef(sender,locator,data); if not result then break; end; end; end; function TXmlDistributor.comment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; var i: integer; begin if assigned(FOnComment) then FOnComment(sender,locator,data); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.comment(sender,locator,data); if not result then break; end; end; end; function TXmlDistributor.doctype(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId, data: wideString): boolean; var i: integer; begin if assigned(FOnDoctype) then FOnDoctype(sender,locator,aname,pubId,sysId,data); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.doctype(sender,locator,aname,pubId,sysId,data); if not result then break; end; end; end; function TXmlDistributor.endDocument(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; var i: integer; begin if assigned(FOnEndDocument) then FOnEndDocument(sender,locator); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.endDocument(sender,locator); if not result then break; end; end; end; function TXmlDistributor.endElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString): boolean; var i: integer; begin if assigned(FOnEndElement) then FOnEndElement(sender,locator,namespaceURI,tagName); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.endElement(sender,locator,namespaceURI,tagName); if not result then break; end; end; end; function TXmlDistributor.endPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix: wideString): boolean; var i: integer; begin if assigned(FOnEndPrefixMapping) then FOnEndPrefixMapping(sender,locator,prefix); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.endPrefixMapping(sender,locator,prefix); if not result then break; end; end; end; function TXmlDistributor.entityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; var i: integer; begin if assigned(FOnEntityRef) then FOnEntityRef(sender,locator,aname); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.entityRef(sender,locator,aname); if not result then break; end; end; end; function TXmlDistributor.PCDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; var i: integer; begin if assigned(FOnPCDATA) then FOnPCDATA(sender,locator,data); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.PCDATA(sender,locator,data); if not result then break; end; end; end; function TXmlDistributor.processingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; var i: integer; begin if assigned(FOnProcessingInstruction) then FOnProcessingInstruction(sender,locator,targ,data); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.processingInstruction(sender,locator,targ,data); if not result then break; end; end; end; function TXmlDistributor.skippedEntity(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; var i: integer; begin if assigned(FOnSkippedEntity) then FOnSkippedEntity(sender,locator,aname); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.skippedEntity(sender,locator,aname); if not result then break; end; end; end; function TXmlDistributor.startDocument(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString; sdDl: TdomStandalone): boolean; var i: integer; begin if assigned(FOnStartDocument) then FOnStartDocument(sender,locator,version,encName,sdDl); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.startDocument(sender,locator,version,encName,sdDl); if not result then break; end; end; end; function TXmlDistributor.startElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString; attributes: TdomNameValueList): boolean; var i: integer; begin if assigned(FOnStartElement) then FOnStartElement(sender,locator,namespaceURI,tagName,attributes); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.startElement(sender,locator,namespaceURI,tagName,attributes); if not result then break; end; end; end; function TXmlDistributor.startPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix, uri: wideString): boolean; var i: integer; begin if assigned(FOnStartPrefixMapping) then FOnStartPrefixMapping(sender,locator,prefix,uri); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.startPrefixMapping(sender,locator,prefix,uri); if not result then break; end; end; end; function TXmlDistributor.attributeDefinition(const sender: TXmlCustomReader; const locator: TdomLocator; aname, attType, bracket, defaultDecl, attValue: wideString): boolean; var i: integer; begin if assigned(FOnAttributeDefinition) then FOnAttributeDefinition(sender,locator,aname,attType,bracket,defaultDecl,attValue); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.attributeDefinition(sender,locator,aname,attType,bracket,defaultDecl,attValue); if not result then break; end; end; end; function TXmlDistributor.conditionalSection(const sender: TXmlCustomReader; const locator: TdomLocator; includeStmt, data: wideString): boolean; var i: integer; begin if assigned(FOnConditionalSection) then FOnConditionalSection(sender,locator,includeStmt,data); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.conditionalSection(sender,locator,includeStmt,data); if not result then break; end; end; end; function TXmlDistributor.DTDcomment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; var i: integer; begin if assigned(FOnDtdComment) then FOnDtdComment(sender,locator,data); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.DTDcomment(sender,locator,data); if not result then break; end; end; end; function TXmlDistributor.DTDprocessingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; var i: integer; begin if assigned(FOnDtdProcessingInstruction) then FOnDtdProcessingInstruction(sender,locator,targ,data); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.DTDprocessingInstruction(sender,locator,targ,data); if not result then break; end; end; end; function TXmlDistributor.elementTypeDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, data: wideString): boolean; var i: integer; begin if assigned(FOnElementTypeDeclaration) then FOnElementTypeDeclaration(sender,locator,aname,data); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.elementTypeDeclaration(sender,locator,aname,data); if not result then break; end; end; end; function TXmlDistributor.endAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; var i: integer; begin if assigned(FOnEndAttListDeclaration) then FOnEndAttListDeclaration(sender,locator); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.endAttListDeclaration(sender,locator); if not result then break; end; end; end; function TXmlDistributor.endExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; var i: integer; begin if assigned(FOnEndExtDtd) then FOnEndExtDtd(sender,locator); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.endExtDtd(sender,locator); if not result then break; end; end; end; function TXmlDistributor.endIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; var i: integer; begin if assigned(FOnendIntDtd) then FOnendIntDtd(sender,locator); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.endIntDtd(sender,locator); if not result then break; end; end; end; function TXmlDistributor.entityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId, notaName: wideString): boolean; var i: integer; begin if assigned(FOnEntityDeclaration) then FOnEntityDeclaration(sender,locator,aname,entityValue,pubId,sysId,notaName); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.entityDeclaration(sender,locator,aname,entityValue,pubId,sysId,notaName); if not result then break; end; end; end; function TXmlDistributor.notationDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId: wideString): boolean; var i: integer; begin if assigned(FOnNotationDeclaration) then FOnNotationDeclaration(sender,locator,aname,pubId,sysId); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.notationDeclaration(sender,locator,aname,pubId,sysId); if not result then break; end; end; end; function TXmlDistributor.parameterEntityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId: wideString): boolean; var i: integer; begin if assigned(FOnParameterEntityDeclaration) then FOnParameterEntityDeclaration(sender,locator,aname,entityValue,pubId,sysId); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.parameterEntityDeclaration(sender,locator,aname,entityValue,pubId,sysId); if not result then break; end; end; end; function TXmlDistributor.parameterEntityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; var i: integer; begin if assigned(FOnParameterEntityRef) then FOnParameterEntityRef(sender,locator,aname); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.parameterEntityRef(sender,locator,aname); if not result then break; end; end; end; function TXmlDistributor.startAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; var i: integer; begin if assigned(FOnStartAttListDeclaration) then FOnStartAttListDeclaration(sender,locator,aname); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.startAttListDeclaration(sender,locator,aname); if not result then break; end; end; end; function TXmlDistributor.startExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator; version, encDl: wideString): boolean; var i: integer; begin if assigned(FOnStartExtDtd) then FOnStartExtDtd(sender,locator,version,encDl); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.startExtDtd(sender,locator,version,encDl); if not result then break; end; end; end; function TXmlDistributor.startIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; var i: integer; begin if assigned(FOnstartIntDtd) then FOnstartIntDtd(sender,locator); result:= true; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.startIntDtd(sender,locator); if not result then break; end; end; end; function TXmlDistributor.resolvePE( PEReferenceName: wideString; var PEValue: wideString; var error: TXmlErrorType): boolean; var i: integer; begin result:= true; PEValue:= ''; error:= ET_UNRESOLVABLE_PARAMETER_ENTITY_REFERENCE; with nextHandlers do begin for i:= 0 to pred(count) do begin if not assigned(items[i].XmlHandler) then continue; result:= items[i].XmlHandler.resolvePE(PEReferenceName,PEValue,error); if (error = ET_NONE) or not result then break; end; end; end; procedure TXmlDistributor.notifyReset; var i: integer; begin with nextHandlers do begin for i:= 0 to pred(count) do begin if assigned(items[i].XmlHandler) then items[i].XmlHandler.notifyReset; end; end; end; // +++++++++++++++++++++++++++ TXmlCustomDTDHandler +++++++++++++++++++++++++++ function TXmlCustomDtdHandler.comment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomDtdHandler.CDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomDtdHandler.charRef(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomDtdHandler.doctype(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId, data: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomDtdHandler.endDocument(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomDtdHandler.endElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomDtdHandler.endPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomDtdHandler.entityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomDtdHandler.PCDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomDtdHandler.processingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomDtdHandler.skippedEntity(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomDtdHandler.startDocument(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString; sdDl: TdomStandalone): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomDtdHandler.startElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString; attributes: TdomNameValueList): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomDtdHandler.startPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix, uri: wideString): boolean; begin raise EParserException.create('Parser error.'); end; // +++++++++++++++++++++++++ TXmlCustomContentHandler +++++++++++++++++++++++++ function TXmlCustomContentHandler.attributeDefinition(const sender: TXmlCustomReader; const locator: TdomLocator; aname, attType, bracket, defaultDecl, attValue: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomContentHandler.conditionalSection(const sender: TXmlCustomReader; const locator: TdomLocator; includeStmt, data: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomContentHandler.DTDcomment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomContentHandler.DTDprocessingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomContentHandler.elementTypeDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, data: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomContentHandler.endAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomContentHandler.endExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomContentHandler.endIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomContentHandler.entityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId, notaName: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomContentHandler.notationDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomContentHandler.parameterEntityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomContentHandler.parameterEntityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomContentHandler.startAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomContentHandler.startExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator; version, encDl: wideString): boolean; begin raise EParserException.create('Parser error.'); end; function TXmlCustomContentHandler.startIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin raise EParserException.create('Parser error.'); end; // +++++++++++++++++++++++++ TXmlCustomReader ++++++++++++++++++++++++++ constructor TXmlCustomReader.create(AOwner: TComponent); begin inherited; FDOMImpl:= nil; FNextHandler:= nil; end; procedure TXmlCustomReader.setDomImpl(const impl: TDomImplementation); begin FDOMImpl:= impl; if assigned(impl) then impl.FreeNotification(Self); end; procedure TXmlCustomReader.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent,Operation); if Operation = opRemove then begin if AComponent = FNextHandler then FNextHandler:= nil; if AComponent = FDOMImpl then FDOMImpl:= nil; end; end; function TXmlCustomReader.sendErrorNotification(const xmlErrorType: TXmlErrorType; const location: TdomLocator; const code: wideString): boolean; var error: TdomError; begin error:= TdomError.createFromLocator(xmlErrorType,location,code); try if assigned(FDomImpl) then begin result:= FDomImpl.handleError(self,error); end else if error.severity = DOM_SEVERITY_FATAL_ERROR then result:= false else result:= true; if not result then if assigned(nextHandler) then nextHandler.notifyReset; finally error.free; end; end; // +++++++++++++++++++++++ TXmlWFTestContentHandler +++++++++++++++++++++++ constructor TXmlWFTestContentHandler.create(AOwner: TComponent); begin inherited create(AOwner); FIsActive:= false; FDoctypeFound:= false; FRootFound:= false; FTestRootFound:= true; FTagStack:= TdomWideStringList.Create; end; destructor TXmlWFTestContentHandler.destroy; begin FTagStack.free; inherited destroy; end; function TXmlWFTestContentHandler.CDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; begin if assigned(FOnCDATA) then FOnCDATA(sender,locator,data); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if not IsXmlCData(data) then begin result:= sendErrorNotification(sender,ET_INVALID_CDATA_SECTION,locator,''); end; if (not FRootFound) and FTestRootFound and result then begin result:= sendErrorNotification(sender,ET_NOT_IN_ROOT,locator,data); end; if result then if assigned(nextHandler) then result:= nextHandler.CDATA(sender,locator,data); end; function TXmlWFTestContentHandler.charRef(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; begin if assigned(FOnCharRef) then FOnCharRef(sender,locator,data); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; try XmlCharRefToStr(data); except on EConvertError do begin result:= sendErrorNotification(sender,ET_INVALID_CHARREF,locator,data); end; end; if (not FRootFound) and FTestRootFound and result then begin result:= sendErrorNotification(sender,ET_NOT_IN_ROOT,locator,data); end; if result then if assigned(nextHandler) then result:= nextHandler.charRef(sender,locator,data); end; function TXmlWFTestContentHandler.comment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; var dataLength: integer; begin if assigned(FOnComment) then FOnComment(sender,locator,data); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if pos('--',data) > 0 then begin result:= sendErrorNotification(sender,ET_INVALID_COMMENT,locator,'--'); end else begin dataLength:= length(data); if dataLength > 0 then if WideChar(data[dataLength]) = '-' then begin result:= sendErrorNotification(sender,ET_INVALID_COMMENT,locator,'-'); end; end; if result then begin if not IsXmlChars(data) then begin result:= sendErrorNotification(sender,ET_INVALID_CHARACTER,locator,data); end; end; if result then if assigned(nextHandler) then result:= nextHandler.comment(sender,locator,data); end; function TXmlWFTestContentHandler.doctype(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId, data: wideString): boolean; begin if assigned(FOnDoctype) then FOnDoctype(sender,locator,aname,pubId,sysId,data); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if FDoctypeFound then begin result:= sendErrorNotification(sender,ET_DOUBLE_DOCTYPE,locator,data); end; FDoctypeFound:= true; if result then begin if FRootFound then begin result:= sendErrorNotification(sender,ET_WRONG_ORDER,locator,data); end; end; if result then begin if not (isXmlName(aname) and isXmlPubidChars(pubId) and isXmlSystemChars(sysId) ) then begin result:= sendErrorNotification(sender,ET_INVALID_DOCTYPE,locator,data); end; end; if result then if assigned(nextHandler) then result:= nextHandler.doctype(sender,locator,aname,pubId,sysId,data); end; function TXmlWFTestContentHandler.endDocument(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnEndDocument) then FOnEndDocument(sender,locator); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; FIsActive:= false; if FTagStack.Count > 0 then begin result:= sendErrorNotification(sender,ET_MISSING_END_TAG,locator,''); end; if (not FRootFound) and FTestRootFound and result then begin result:= sendErrorNotification(sender,ET_NOT_IN_ROOT,locator,''); end; FDoctypeFound:= false; FRootFound:= false; if result then if assigned(nextHandler) then result:= nextHandler.endDocument(sender,locator); end; function TXmlWFTestContentHandler.endElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString): boolean; var lastItemIndex: integer; begin if assigned(FOnEndElement) then FOnEndElement(sender,locator,namespaceURI,tagName); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if not IsXmlName(tagName) then begin result:= sendErrorNotification(sender,ET_INVALID_ELEMENT_NAME,locator,tagname); end; if result then begin lastItemIndex:= pred(FTagStack.Count); if lastItemIndex = -1 then begin result:= sendErrorNotification(sender,ET_MISSING_START_TAG,locator,tagname); end else begin if FTagStack[lastItemIndex] = tagname then FTagStack.Delete(lastItemIndex) else begin result:= sendErrorNotification(sender,ET_MISSING_START_TAG,locator,tagname); end; end; end; if result then if assigned(nextHandler) then result:= nextHandler.endElement(sender,locator,namespaceURI,tagName); end; function TXmlWFTestContentHandler.endPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix: wideString): boolean; begin if assigned(FOnEndPrefixMapping) then FOnEndPrefixMapping(sender,locator,prefix); if assigned(nextHandler) then result:= nextHandler.endPrefixMapping(sender,locator,prefix) else result:= true; end; function TXmlWFTestContentHandler.entityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; begin if assigned(FOnEntityRef) then FOnEntityRef(sender,locator,aname); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if not IsXmlName(aname) then begin result:= sendErrorNotification(sender,ET_INVALID_ENTITY_NAME,locator,aname); end; if (not FRootFound) and FTestRootFound and result then begin result:= sendErrorNotification(sender,ET_NOT_IN_ROOT,locator,'&' + name +';'); end; if result then if assigned(nextHandler) then result:= nextHandler.entityRef(sender,locator,aname); end; function TXmlWFTestContentHandler.PCDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; begin if assigned(FOnPCDATA) then FOnPCDATA(sender,locator,data); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if not IsXmlCharData(data) then begin result:= sendErrorNotification(sender,ET_INVALID_CHARACTER,locator,data); end; if (not FRootFound) and (not IsXmlS(data)) and FTestRootFound and result then begin result:= sendErrorNotification(sender,ET_NOT_IN_ROOT,locator,data); end; if result then if assigned(nextHandler) then result:= nextHandler.PCDATA(sender,locator,data); end; function TXmlWFTestContentHandler.processingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; begin if assigned(FOnProcessingInstruction) then FOnProcessingInstruction(sender,locator,targ,data); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if not IsXmlPITarget(targ) then begin result:= sendErrorNotification(sender,ET_INVALID_PROCESSING_INSTRUCTION,locator,targ); end else begin if pos('?>',data) > 0 then begin result:= sendErrorNotification(sender,ET_INVALID_PROCESSING_INSTRUCTION,locator,'?>'); end; end; if result then begin if not IsXmlChars(data) then begin result:= sendErrorNotification(sender,ET_INVALID_CHARACTER,locator,data); end; end; if result then if assigned(nextHandler) then result:= nextHandler.processingInstruction(sender,locator,targ,data); end; function TXmlWFTestContentHandler.skippedEntity(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; begin if assigned(FOnSkippedEntity) then FOnSkippedEntity(sender,locator,aname); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if result then if assigned(nextHandler) then result:= nextHandler.skippedEntity(sender,locator,aname); end; function TXmlWFTestContentHandler.startDocument(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString; sdDl: TdomStandalone): boolean; begin if assigned(FOnStartDocument) then FOnStartDocument(sender,locator,version,encName,sdDl); if FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; FTagStack.Clear; FIsActive:= true; FDoctypeFound:= false; FRootFound:= false; if not ( ( IsXmlEncName(encName) or (encName = '') ) and ( IsXmlVersionNum(version) or (version = '') ) ) then begin result:= sendErrorNotification(sender,ET_INVALID_XML_DECL,locator,''); end; if result then if assigned(nextHandler) then result:= nextHandler.startDocument(sender,locator,version,encName,sdDl); end; function TXmlWFTestContentHandler.startElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString; attributes: TdomNameValueList): boolean; var i,j: integer; name,value,text,characRef,v: wideString; isEntity: boolean; begin if assigned(FOnStartElement) then FOnStartElement(sender,locator,namespaceURI,tagName,attributes); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if not IsXmlName(tagName) then begin result:= sendErrorNotification(sender,ET_INVALID_ELEMENT_NAME,locator,tagname); end; if (FTagStack.Count = 0) and FTestRootFound and FRootFound and result then begin result:= sendErrorNotification(sender,ET_DOUBLE_ROOT_ELEMENT,locator,tagname); end; FRootFound:= true; FTagStack.Add(tagname); if result then begin for i:= 0 to pred(attributes.length) do begin value:= attributes.values[i]; name:= attributes.names[i]; if attributes.indexOfName(name) <> i then begin result:= sendErrorNotification(sender,ET_INVALID_ELEMENT_NAME,locator,name); if not result then break; end; if not IsXmlName(name) then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_NAME,locator,value); if not result then break; end; if pos('&',value) = 0 then begin if not IsXmlCharData(value) then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_VALUE,locator,value); if not result then break; end; end else begin isEntity:= false; text:= ''; for j:= 1 to Length(value) do begin if IsEntity then begin if value[j] = ';' then begin if text[1] = '#' then begin // CharRef try CharacRef:= concat(wideString('&'),text,wideString(';')); v:= XmlCharRefToStr(CharacRef); except on EConvertError do begin result:= sendErrorNotification(sender,ET_INVALID_CHARREF,locator,CharacRef); if not result then break; end; end; {try} end else begin // EntityRef if not IsXmlName(text) then begin result:= sendErrorNotification(sender,ET_INVALID_ENTITY_NAME,locator,text); if not result then break; end; end; text:= ''; IsEntity:= false; end else Text:= concat(text,wideString(value[j])); end else begin if value[j] = '&' then begin IsEntity:= true; end else if (value[j] = '<') or not IsXmlChar(value[j]) then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_VALUE,locator,value); if not result then break; end; end; {if ...} end; {for ...} // invalid attribute value? if result then begin if IsEntity then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_VALUE,locator,value); end; {if ...} end; {if ...} end; {if ...} end; end; {if result ...} if result then if assigned(nextHandler) then result:= nextHandler.startElement(sender,locator,namespaceURI,tagName,attributes); end; function TXmlWFTestContentHandler.startPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix, uri: wideString): boolean; begin if assigned(FOnStartPrefixMapping) then FOnStartPrefixMapping(sender,locator,prefix,uri); if assigned(nextHandler) then result:= nextHandler.startPrefixMapping(sender,locator,prefix,uri) else result:= true; end; procedure TXmlWFTestContentHandler.notifyReset; begin FIsActive:= false; FDoctypeFound:= false; FRootFound:= false; FTagStack.clear; if assigned(nextHandler) then nextHandler.notifyReset; end; // +++++++++++++++++++++++++ TXmlWFTestDTDHandler +++++++++++++++++++++++++ constructor TXmlWFTestDTDHandler.create(AOwner: TComponent); begin inherited; FAttListDeclActive:= false; FExtDtdIsActive:= false; FIntDtdIsActive:= false; end; destructor TXmlWFTestDTDHandler.destroy; begin inherited; end; function TXmlWFTestDTDHandler.attributeDefinition(const sender: TXmlCustomReader; const locator: TdomLocator; aname, attType, bracket, defaultDecl, attValue: wideString): boolean; begin if assigned(FOnAttributeDefinition) then FOnAttributeDefinition(sender,locator,aname,attType,bracket,defaultDecl,attValue); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if not FAttListDeclActive then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end; if result then begin if not IsXmlName(aname) then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end; end; if result then if assigned(nextHandler) then result:= nextHandler.attributeDefinition(sender,locator,aname,attType,bracket,defaultDecl,attValue); end; function TXmlWFTestDTDHandler.conditionalSection(const sender: TXmlCustomReader; const locator: TdomLocator; includeStmt, data: wideString): boolean; begin if assigned(FOnConditionalSection) then FOnConditionalSection(sender,locator,includeStmt,data); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if FAttListDeclActive then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end; if result then begin if FIntDtdIsActive or ( not ((IncludeStmt = 'INCLUDE') or (IncludeStmt = 'IGNORE')) ) then begin result:= sendErrorNotification(sender,ET_INVALID_CONDITIONAL_SECTION,locator,name); end; end; if result then if assigned(nextHandler) then result:= nextHandler.conditionalSection(sender,locator,includeStmt,data); end; function TXmlWFTestDTDHandler.DTDcomment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; var dataLength: integer; begin if assigned(FOnDTDcomment) then FOnDTDcomment(sender,locator,data); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if FAttListDeclActive then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end; if pos('--',data) > 0 then begin result:= sendErrorNotification(sender,ET_INVALID_COMMENT,locator,'--'); end else begin dataLength:= length(data); if dataLength > 0 then if WideChar(data[dataLength]) = '-' then begin result:= sendErrorNotification(sender,ET_INVALID_COMMENT,locator,'-'); end; end; if result then begin if not IsXmlChars(data) then begin result:= sendErrorNotification(sender,ET_INVALID_CHARACTER,locator,data); end; end; if result then if assigned(nextHandler) then result:= nextHandler.DTDcomment(sender,locator,data); end; function TXmlWFTestDTDHandler.DTDprocessingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data: wideString): boolean; begin if assigned(FOnDTDprocessingInstruction) then FOnDTDprocessingInstruction(sender,locator,targ,data); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if FAttListDeclActive then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end; if not IsXmlPITarget(targ) then begin result:= sendErrorNotification(sender,ET_INVALID_PROCESSING_INSTRUCTION,locator,targ); end else begin if pos('?>',data) > 0 then begin result:= sendErrorNotification(sender,ET_INVALID_PROCESSING_INSTRUCTION,locator,'?>'); end; end; if result and not IsXmlChars(data) then begin result:= sendErrorNotification(sender,ET_INVALID_CHARACTER,locator,data); end; if result then if assigned(nextHandler) then result:= nextHandler.DTDprocessingInstruction(sender,locator,targ,data); end; function TXmlWFTestDTDHandler.elementTypeDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, data: wideString): boolean; begin if assigned(FOnElementTypeDeclaration) then FOnElementTypeDeclaration(sender,locator,aname,data); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if FAttListDeclActive then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end; if result and not IsXmlName(aname) then begin result:= sendErrorNotification(sender,ET_INVALID_ELEMENT_DECL,locator,name); end; if result then if assigned(nextHandler) then result:= nextHandler.elementTypeDeclaration(sender,locator,aname,data); end; function TXmlWFTestDTDHandler.endAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnEndAttListDeclaration) then FOnEndAttListDeclaration(sender,locator); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if not FAttListDeclActive then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end; FAttListDeclActive:= false; if result then if assigned(nextHandler) then result:= nextHandler.endAttListDeclaration(sender,locator); end; function TXmlWFTestDTDHandler.endExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnEndExtDtd) then FOnEndExtDtd(sender,locator); if FIntDtdIsActive or not FextDtdIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; FExtDtdIsActive:= false; if FAttListDeclActive then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end; if result then if assigned(nextHandler) then result:= nextHandler.endExtDtd(sender,locator); end; function TXmlWFTestDTDHandler.endIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnEndIntDtd) then FOnEndIntDtd(sender,locator); if FExtDtdIsActive or not FIntDtdIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; FIntDtdIsActive:= false; if FAttListDeclActive then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end; if result then if assigned(nextHandler) then result:= nextHandler.endIntDtd(sender,locator); end; function TXmlWFTestDTDHandler.entityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId, notaName: wideString): boolean; var error: boolean; begin if assigned(FOnEntityDeclaration) then FOnEntityDeclaration(sender,locator,aname,entityValue,pubId,sysId,notaName); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if FAttListDeclActive then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end; if result then begin error:= false; if not IsXmlName(aname) then error:= true; if entityValue <> '' then begin if not IsXmlEntityValueChars(entityValue) then error:= true; if not ( (pubId = '') and (sysId = '') ) then error:= true; end; if not isXmlSystemChars(sysId) then error:= true; if not isXmlPubidChars(pubId) then error:= true; if error then begin result:= sendErrorNotification(sender,ET_INVALID_ENTITY_DECL,locator,aname); end; end; if result then if assigned(nextHandler) then result:= nextHandler.entityDeclaration(sender,locator,name,entityValue,pubId,sysId,notaName); end; function TXmlWFTestDTDHandler.notationDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId: wideString): boolean; var error: boolean; begin if assigned(FOnNotationDeclaration) then FOnNotationDeclaration(sender,locator,aname,pubId,sysId); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if FAttListDeclActive then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end; if result then begin error:= false; if not IsXmlName(aname) then error:= true; if not isXmlSystemChars(sysId) then error:= true; if not isXmlPubidChars(pubId) then error:= true; if error then begin result:= sendErrorNotification(sender,ET_INVALID_NOTATION_DECL,locator,aname); end; end; if result then if assigned(nextHandler) then result:= nextHandler.notationDeclaration(sender,locator,aname,pubId,sysId); end; function TXmlWFTestDTDHandler.parameterEntityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId: wideString): boolean; var error: boolean; begin if assigned(FOnParameterEntityDeclaration) then FOnParameterEntityDeclaration(sender,locator,aname,entityValue,pubId,sysId); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if FAttListDeclActive then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end; if result then begin error:= false; if not IsXmlName(aname) then error:= true; if entityValue <> '' then begin if not IsXmlEntityValueChars(entityValue) then error:= true; if not ( (pubId = '') and (sysId = '') ) then error:= true; end; if not isXmlSystemChars(sysId) then error:= true; if not isXmlPubidChars(pubId) then error:= true; if error then begin result:= sendErrorNotification(sender,ET_INVALID_ENTITY_DECL,locator,aname); end; end; if result then if assigned(nextHandler) then result:= nextHandler.parameterEntityDeclaration(sender,locator,aname,entityValue,pubId,sysId); end; function TXmlWFTestDTDHandler.parameterEntityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; begin if assigned(FOnParameterEntityRef) then FOnParameterEntityRef(sender,locator,aname); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if FAttListDeclActive then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end; if result and not IsXmlName(aname) then begin result:= sendErrorNotification(sender,ET_INVALID_ENTITY_NAME,locator,aname); end; if result then if assigned(nextHandler) then result:= nextHandler.parameterEntityRef(sender,locator,aname); end; function TXmlWFTestDTDHandler.startAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; begin if assigned(FOnStartAttListDeclaration) then FOnStartAttListDeclaration(sender,locator,aname); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if FAttListDeclActive or not IsXmlName(aname) then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end; FAttListDeclActive:= true; if result then if assigned(nextHandler) then result:= nextHandler.startAttListDeclaration(sender,locator,aname); end; function TXmlWFTestDTDHandler.startExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString): boolean; begin if assigned(FOnStartExtDtd) then FOnStartExtDtd(sender,locator,version,encName); if FIntDtdIsActive or FExtDtdIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; FExtDtdIsActive:= true; if not ( ( IsXmlEncName(encName) or (encName = '') ) and ( IsXmlVersionNum(version) or (version = '') ) ) then begin result:= sendErrorNotification(sender,ET_INVALID_TEXT_DECL,locator,''); end; if result then if assigned(nextHandler) then result:= nextHandler.startExtDtd(sender,locator,version,encName); end; function TXmlWFTestDTDHandler.startIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnStartIntDtd) then FOnStartIntDtd(sender,locator); if FIntDtdIsActive or FExtDtdIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; FIntDtdIsActive:= true; if result then if assigned(nextHandler) then result:= nextHandler.startIntDtd(sender,locator); end; procedure TXmlWFTestDTDHandler.notifyReset; begin FAttListDeclActive:= false; FExtDtdIsActive:= false; FIntDtdIsActive:= false; if assigned(nextHandler) then nextHandler.notifyReset; end; // ++++++++++++++++++++++++++++ TXmlDocBuilder ++++++++++++++++++++++++++++ constructor TXmlDocBuilder.create(AOwner: TComponent); begin inherited create(AOwner); FRefNode:= nil; FBuildNamespaceTree:= false; FPrefixUriList:= TdomNameValueList.create; end; destructor TXmlDocBuilder.destroy; begin FPrefixUriList.free; inherited destroy; end; function TXmlDocBuilder.CDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; var newCData: TdomCDATASection; begin if assigned(FOnCDATA) then FOnCDATA(sender,locator,data); result:= true; if assigned(FRefNode) then begin try newCData:= FRefNode.OwnerDocument.CreateCDATASection(data); try FRefNode.appendChild(newCData); except if assigned(newCData.ParentNode) then newCData.ParentNode.RemoveChild(newCData); FRefNode.OwnerDocument.FreeAllNodes(TdomNode(newCData)); raise; end; {try ...} except result:= sendErrorNotification(sender,ET_INVALID_CDATA_SECTION,locator,data); end; {try ...} end; {if assigned(FRefNode) ...} if result then if assigned(nextHandler) then result:= nextHandler.CDATA(sender,locator,data); end; function TXmlDocBuilder.charRef(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; var newText: TdomText; previousNode: TdomNode; value: wideString; previousNodeIsText: boolean; begin if assigned(FOnCharRef) then FOnCharRef(sender,locator,data); result:= true; if assigned(FRefNode) then begin try value:= XmlCharRefToStr(data); except result:= sendErrorNotification(sender,ET_INVALID_CHARACTER,locator,data); end; if result then begin previousNode:= FRefNode.LastChild; if assigned(previousNode) then begin if (previousNode.NodeType = ntText_Node) then previousNodeIsText:= true else previousNodeIsText:= false; end else previousNodeIsText:= false; if previousNodeIsText then (previousNode as TdomText).appendData(value) else begin try newText:= FRefNode.OwnerDocument.CreateTextNode(value); try FRefNode.appendChild(newText); except if assigned(newText.ParentNode) then newText.ParentNode.RemoveChild(newText); FRefNode.OwnerDocument.FreeAllNodes(TdomNode(newText)); raise; end; {try ...} except result:= sendErrorNotification(sender,ET_INVALID_CHARREF,locator,data); end; {try ...} end; end; {if not assgined ...} end; {if assigned(FRefNode) ...} if result then if assigned(nextHandler) then result:= nextHandler.charRef(sender,locator,data); end; function TXmlDocBuilder.comment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; var newComment: TdomComment; begin if assigned(FOnComment) then FOnComment(sender,locator,data); result:= true; if assigned(FRefNode) then begin try newComment:= FRefNode.OwnerDocument.CreateComment(data); try FRefNode.appendChild(newComment); except if assigned(newComment.ParentNode) then newComment.ParentNode.RemoveChild(newComment); FRefNode.OwnerDocument.FreeAllNodes(TdomNode(newComment)); raise; end; {try ...} except result:= sendErrorNotification(sender,ET_INVALID_COMMENT,locator,data); end; {try ...} end; {if assigned(FRefNode) ...} if result then if assigned(nextHandler) then result:= nextHandler.comment(sender,locator,data); end; function TXmlDocBuilder.doctype(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId, data: wideString): boolean; var newDocType: TdomDocumentType; begin if assigned(FOnDoctype) then FOnDoctype(sender,locator,aname,pubId,sysId,data); result:= true; if assigned(FRefNode) then begin try newDocType:= FRefNode.OwnerDocument.CreateDocumentType(aname,pubId,sysId,data); try FRefNode.appendChild(newDocType); except if assigned(newDocType.ParentNode) then newDocType.ParentNode.RemoveChild(newDocType); FRefNode.OwnerDocument.FreeAllNodes(TdomNode(newDocType)); raise; end; {try ...} except result:= sendErrorNotification(sender,ET_INVALID_DOCTYPE,locator,data); end; {try ...} end; {if assigned(FRefNode) ...} if result then if assigned(nextHandler) then result:= nextHandler.doctype(sender,locator,aname,pubId,sysId,data); end; function TXmlDocBuilder.endDocument(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnEndDocument) then FOnEndDocument(sender,locator); // notifications of endDocument are being ignored. result:= true; if assigned(nextHandler) then result:= nextHandler.endDocument(sender,locator); end; function TXmlDocBuilder.endElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString): boolean; begin if assigned(FOnEndElement) then FOnEndElement(sender,locator,namespaceURI,tagName); result:= true; if assigned(FRefNode) then begin // xxx Evaluate 'FBuildNamespaceTree' and 'namespaceURI' here, too? if not ( (FRefNode.nodeType = ntElement_Node) and (tagName = FRefNode.NodeName) ) then begin result:= sendErrorNotification(sender,ET_MISSING_START_TAG,locator,tagname); end else FRefNode:= FRefNode.ParentNode; end; if result then if assigned(nextHandler) then result:= nextHandler.endElement(sender,locator,namespaceURI,tagName); end; function TXmlDocBuilder.endPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix: wideString): boolean; var l: integer; begin if assigned(FOnEndPrefixMapping) then FOnEndPrefixMapping(sender,locator,prefix); l:= pred(FPrefixUriList.length); if l = -1 then begin result:= sendErrorNotification(sender,ET_WRONG_PREFIX_MAPPING_NESTING,locator,prefix); end else begin if FPrefixUriList.names[l] <> prefix then begin result:= sendErrorNotification(sender,ET_WRONG_PREFIX_MAPPING_NESTING,locator,prefix); end else begin FPrefixUriList.Delete(l); result:= true; end; end; if result then if assigned(nextHandler) then result:= nextHandler.endPrefixMapping(sender,locator,prefix); end; function TXmlDocBuilder.entityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; var newEntityRef: TdomEntityReference; begin if assigned(FOnEntityRef) then FOnEntityRef(sender,locator,aname); result:= true; if assigned(FRefNode) then begin try newEntityRef:= FRefNode.OwnerDocument.CreateEntityReference(aname); try FRefNode.appendChild(newEntityRef); except if assigned(newEntityRef.ParentNode) then newEntityRef.ParentNode.RemoveChild(newEntityRef); FRefNode.OwnerDocument.FreeAllNodes(TdomNode(newEntityRef)); raise; end; {try ...} except result:= sendErrorNotification(sender,ET_INVALID_ENTITY_NAME,locator,aname); end; {try ...} end; {if assigned(FRefNode) ...} if result then if assigned(nextHandler) then result:= nextHandler.entityRef(sender,locator,aname); end; function TXmlDocBuilder.PCDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; var newPcdata: TdomText; begin if assigned(FOnPCDATA) then FOnPCDATA(sender,locator,data); result:= true; if assigned(FRefNode) then begin if (FRefNode.NodeType = ntDocument_Node) then begin if not IsXmlS(data) then begin result:= sendErrorNotification(sender,ET_INVALID_ENTITY_NAME,locator,name); end; end else begin if assigned(FRefNode.LastChild) and (FRefNode.LastChild.NodeType = ntText_Node) then (FRefNode.LastChild as TdomText).appendData(data) else begin try newPcdata:= FRefNode.OwnerDocument.CreateTextNode(data); try FRefNode.appendChild(newPcdata); except if assigned(newPcdata.ParentNode) then newPcdata.ParentNode.RemoveChild(newPcdata); FRefNode.OwnerDocument.FreeAllNodes(TdomNode(newPcdata)); raise; end; {try ...} except result:= sendErrorNotification(sender,ET_INVALID_CHARACTER,locator,data); end; {try ...} end; end; {if (FRefNode.NodeType = ntDocument_Node) then ... else ...} end; {if assigned(FRefNode) ...} if result then if assigned(nextHandler) then result:= nextHandler.PCDATA(sender,locator,data); end; function TXmlDocBuilder.processingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; var newPI: TdomProcessingInstruction; begin if assigned(FOnProcessingInstruction) then FOnProcessingInstruction(sender,locator,targ,data); result:= true; if assigned(FRefNode) then begin try newPI:= FRefNode.OwnerDocument.CreateProcessingInstruction(targ,data); try FRefNode.appendChild(newPI); except if assigned(newPI.ParentNode) then newPI.ParentNode.RemoveChild(newPI); FRefNode.OwnerDocument.FreeAllNodes(TdomNode(newPI)); raise; end; except result:= sendErrorNotification(sender,ET_INVALID_PROCESSING_INSTRUCTION,locator,targ); end; end; {if assigned(FRefNode) ...} if result then if assigned(nextHandler) then result:= nextHandler.processingInstruction(sender,locator,targ,data); end; function TXmlDocBuilder.skippedEntity(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; begin if assigned(FOnSkippedEntity) then FOnSkippedEntity(sender,locator,aname); // notifications through skippedEntity() are being ignored. result:= true; if assigned(nextHandler) then result:= nextHandler.skippedEntity(sender,locator,aname); end; function TXmlDocBuilder.startDocument(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString; sdDl: TdomStandalone): boolean; begin if assigned(FOnStartDocument) then FOnStartDocument(sender,locator,version,encName,sdDl); FPrefixUriList.clear; result:= true; if assigned(FRefNode) then begin if (FRefNode.nodeType = ntDocument_Node) then begin if assigned(locator) // xxx evaluate version, encName and sdDl, too? then (FRefNode as TdomDocument).systemId:= locator.uri else (FRefNode as TdomDocument).systemId:= ''; end; end; if assigned(nextHandler) then result:= nextHandler.startDocument(sender,locator,version,encName,sdDl); end; function TXmlDocBuilder.startElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString; attributes: TdomNameValueList): boolean; type TKindOfToken = (IS_EMPTY,IS_TEXT,IS_REFSTART,IS_CHARREF,IS_ENTITYREF); var newElement: TdomElement; i,j: integer; prfx,localName,elementNsUri,AttrNsUri,name,value: wideString; Attri: TdomAttr; pfxFound: boolean; kindOfToken: TKindOfToken; text, reference: TdomCustomStr; begin if assigned(FOnStartElement) then FOnStartElement(sender,locator,namespaceURI,tagName,attributes); result:= true; elementNsUri:= ''; if FBuildNamespaceTree then begin if xmlExtractPrefixAndLocalName(tagName,prfx,localName) then begin pfxFound:= false; with FPrefixUriList do begin for i:= pred(FPrefixUriList.length) downto 0 do if FPrefixUriList.names[i] = prfx then begin elementNsUri:= FPrefixUriList.values[i]; pfxFound:= true; break; end; end; {with ...} if not pfxFound and (prfx <> '') then begin result:= sendErrorNotification(sender,ET_NAMESPACE_URI_NOT_FOUND,locator,tagname); end; end else begin result:= sendErrorNotification(sender,ET_INVALID_QUALIFIED_NAME,locator,tagname); end; {if ... else ...} end; {if FBuildNamespaceTree ...} if result then begin if assigned(FRefNode) then begin try if FBuildNamespaceTree then newElement:= FRefNode.OwnerDocument.CreateElementNS(elementNsUri,tagName) else newElement:= FRefNode.OwnerDocument.CreateElement(tagName); except // xxx not elegant. result:= sendErrorNotification(sender,ET_INVALID_ELEMENT_NAME,locator,tagname); exit; end; // Compute attributes: text:= TdomCustomStr.create; reference:= TdomCustomStr.create; try try for i:= 0 to pred(attributes.length) do begin value:= attributes.values[i]; name:= attributes.names[i]; prfx:= ''; attrNsUri:= ''; if FBuildNamespaceTree then begin if xmlExtractPrefixAndLocalName(name,prfx,localName) then begin if name = 'xmlns' then begin attrNsUri:= 'http://www.w3.org/2000/xmlns/'; end else begin if prfx = '' then begin attrNsUri:= ''; end else if prfx = 'xml' then begin attrNsUri:= 'http://www.w3.org/XML/1998/namespace'; end else if prfx = 'xmlns' then begin attrNsUri:= 'http://www.w3.org/2000/xmlns/'; end else begin pfxFound:= false; with FPrefixUriList do begin for j:= pred(FPrefixUriList.length) downto 0 do begin if FPrefixUriList.names[j] = prfx then begin attrNsUri:= FPrefixUriList.values[j]; pfxFound:= true; break; end; {if ...} end; {for ...} end; {with ...} if not pfxFound then begin result:= sendErrorNotification(sender,ET_NAMESPACE_URI_NOT_FOUND,locator,name); exit; end; {if not pfxFound ...} end; {if prfx = '' ... else ...} end; {if name = 'xmlns' ...} end else begin result:= sendErrorNotification(sender,ET_INVALID_QUALIFIED_NAME,locator,name); exit; end; {if... else ...} end; {if FBuildNamespaceTree ...} if result then begin if not IsXmlName(name) then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_NAME,locator,name); exit; end; {if ...} if FBuildNamespaceTree then begin Attri:= newElement.OwnerDocument.CreateAttributeNS(attrNsUri,name); newElement.SetAttributeNodeNS(Attri); end else begin Attri:= newElement.OwnerDocument.CreateAttribute(name); newElement.SetAttributeNode(Attri); end; kindOfToken:= IS_EMPTY; text.reset; for j:= 1 to length(value) do begin case kindOfToken of IS_TEXT: if value[j] = '&' then kindOfToken:= IS_REFSTART else text.addWideChar(value[j]); IS_REFSTART: if value[j] = '#' then begin reference.reset; reference.addWideString('&#'); kindOfToken:= IS_CHARREF; end else begin if text.length > 0 then Attri.appendChild(newElement.OwnerDocument.CreateTextNode(text.value)); kindOfToken:= IS_ENTITYREF; reference.reset; reference.addWideChar(value[j]); end; IS_CHARREF: if value[j] = ';' then begin reference.addWideChar(';'); text.addWideString(XmlCharRefToStr(reference.value)); kindOfToken:= IS_TEXT; end else reference.addWideString(value[j]); IS_ENTITYREF: if value[j] = ';' then begin Attri.appendChild(newElement.OwnerDocument.CreateEntityReference(reference.value)); kindOfToken:= IS_EMPTY; text.reset; end else reference.addWideString(value[j]); IS_EMPTY: if value[j] = '&' then begin kindOfToken:= IS_REFSTART; end else begin kindOfToken:= IS_TEXT; text.addWideString(value[j]); end; end; {case ...} end; {for ...} case kindOfToken of IS_TEXT: Attri.appendChild(newElement.OwnerDocument.CreateTextNode(text.value)); IS_REFSTART, IS_CHARREF, IS_ENTITYREF: begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_VALUE,locator,name); exit; end; {if ...} end; {case ...} end; end; if assigned(newElement) then FRefNode.appendChild(newElement); except if assigned(newElement.ParentNode) then newElement.ParentNode.RemoveChild(newElement); FRefNode.OwnerDocument.FreeAllNodes(TdomNode(newElement)); result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_VALUE,locator,value); end; {try ...} finally text.Free; reference.Free; end; if assigned(newElement) then FRefNode:= newElement; end; {if assigned(FRefNode) ...} end; {if result ...} if result then if assigned(nextHandler) then result:= nextHandler.startElement(sender,locator,namespaceURI,tagName,attributes); end; function TXmlDocBuilder.startPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix, uri: wideString): boolean; const sQuote: wideString = #$0027; dQuote: wideString = '"'; begin if assigned(FOnStartPrefixMapping) then FOnStartPrefixMapping(sender,locator,prefix,uri); result:= true; if ( (prefix = 'xmlns') and (uri <> 'http://www.w3.org/2000/xmlns/') ) or ( (prefix <> '') and not isXmlPrefix(prefix) ) then begin result:= sendErrorNotification(sender,ET_INVALID_PREFIX,locator,prefix); end else begin if not ( IsXMLAttValue(concat(dQuote,uri,dQuote)) or IsXMLAttValue(concat(sQuote,uri,sQuote)) ) then begin result:= sendErrorNotification(sender,ET_INVALID_NAMESPACE_URI,locator,uri); end else FPrefixUriList.add(prefix,uri); end; if result then if assigned(nextHandler) then result:= nextHandler.startPrefixMapping(sender,locator,prefix,uri) end; procedure TXmlDocBuilder.notifyReset; begin FPrefixUriList.clear; if assigned(nextHandler) then nextHandler.notifyReset; end; // ++++++++++++++++++++++++++ TXmlDtdBuilder +++++++++++++++++++++++++++ constructor TXmlDtdBuilder.create(AOwner: TComponent); begin inherited create(AOwner); FReferenceExtCM:= nil; FReferenceIntCM:= nil; FRefNode:= nil; FExtDtdIsActive:= false; FIntDtdIsActive:= false; end; function TXmlDtdBuilder.resolvePE( PEReferenceName: wideString; var PEValue: wideString; var error: TXmlErrorType): boolean; begin if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; intContentModel.getValueOfPE(PEReferenceName,PEValue,error); if error <> ET_NONE // xxx Is this correct? What happens if there is an error? then extContentModel.getValueOfPE(PEReferenceName,PEValue,error); end; procedure TXmlDtdBuilder.ResolveCharRefsAndPERefs(const s: wideString; var result: wideString; var error: boolean); var i,j,indexpos: integer; SChar, SChar2: widechar; name,ref,value: wideString; content: TdomCustomStr; errType: TXmlErrorType; begin Result:= ''; Error:= false; content:= TdomCustomStr.create; try i:= 1; while i <= length(S) do begin SChar:= WideChar((PWideChar(S)+i-1)^); if IsUtf16LowSurrogate(sChar) then raise EConvertError.CreateFmt('%S must not start with a UTF-16 low surrogate.',[S]); if IsUtf16HighSurrogate(SChar) then begin if i+1 > length(s) then raise EConvertError.CreateFmt('%S must not end with a UTF-16 high surrogate.',[S]); inc(i); content.addWideChar(SChar); SChar:= WideChar((PWideChar(S)+i-1)^); if not IsUtf16LowSurrogate(SChar) then raise EConvertError.CreateFmt('%S contains an UTF-16 high surrogate without its corresponding low surrogate.',[S]); end; if not IsXmlChar(sChar) then raise EConvertError.CreateFmt('%S contains an invalid character.',[S]); if SChar = '&' then begin {Reference?} indexpos:= -1; for j:= i+1 to length(S) do begin SChar2:= WideChar((PWideChar(S)+j-1)^); if SChar2 = ';' then begin indexpos:= j; break; end; end; if indexpos = -1 then raise EConvertError.CreateFmt('%S contains an ''&'' without a '';''.',[S]); ref:= copy(S,i,j-i+1); if IsXmlEntityRef(ref) then begin content.addWideString(ref); end else if IsXmlCharRef(ref) then begin content.addWideString(XmlCharRefToStr(ref)); end else raise EConvertError.CreateFmt('%S contains an invalid reference.',[S]); i:= j; end else if SChar = '%' then begin // PEReference? indexpos:= -1; for j:= i+1 to length(S) do begin SChar2:= WideChar((PWideChar(S)+j-1)^); if SChar2 = ';' then begin indexpos:= j; break; end; end; if indexpos = -1 then raise EConvertError.CreateFmt('%S contains an ''%'' without a '';''.',[S]); ref:= copy(S,i,j-i+1); if IsXmlPEReference(ref) then begin name:= copy(ref,2,length(ref)-2); resolvePE(name,value,errType); if errType <> ET_NONE then raise EConvertError.CreateFmt('%S contains an invalid parameter entity reference.',[S]); content.addWideString(value); end else raise EConvertError.CreateFmt('%S contains an invalid parameter entity reference.',[S]); i:= j; end else content.addWideChar(SChar); inc(i); end; {while ...} Result:= content.value; finally content.free; end; end; procedure TXmlDtdBuilder.insertMixedContent(const sender: TXmlCustomReader; const refNode: TdomCMNode; const contSpec: wideString); var freq, dummy, content,piece: wideString; separator: integer; Error: boolean; newNode: TdomCMNode; begin content:= XMLTrunc(contSpec); freq:= ''; if (content[length(content)] = '*') then begin freq:= '*'; dummy:= copy(content,1,length(content)-1); content:= dummy; end; if length(content) = 0 then raise EParserException.create('Parser error.'); if wideChar(content[length(content)]) <> ')' then raise EParserException.create('Parser error.'); XMLTruncRoundBrackets(content,dummy,Error); if Error or (dummy = '') then raise EParserException.create('Parser error.'); content:= dummy; newNode:= refNode.appendChild(refNode.OwnerCMObject.CreateCMPcdataChoiceParticle); if content = '#PCDATA' then exit; if freq = '' then raise EParserException.create('Parser error.'); separator:= pos(wideString('|'),content); if separator = 0 then raise EParserException.create('Parser error.'); dummy:= XMLTrunc(copy(content,separator+1,length(content)-separator)); content:= dummy; while content <> '' do begin separator:= pos(wideString('|'),content); if separator = 0 then begin piece:= content; content:= ''; end else begin piece:= XMLTrunc(copy(content,1,separator-1)); dummy:= XMLTrunc(copy(content,separator+1,length(content)-separator)); content:= dummy; if content = '' then raise EParserException.create('Parser error.'); end; {if ...} if not IsXmlName(piece) then raise EParserException.create('Parser error.'); newNode.appendChild(newNode.OwnerCMObject.CreateCMElementParticle(piece,'')); end; {while ...} end; procedure TXmlDtdBuilder.insertChildrenContent(const sender: TXmlCustomReader; const refNode: TdomCMNode; const contSpec: wideString); var piece,dummy,content,freq: wideString; SeparatorChar: WideChar; j,i,bracketNr: integer; newNode: TdomCMNode; Error: boolean; begin content:= XMLTrunc(contSpec); freq:= ''; if (content[length(content)] = WideChar('?')) or (content[length(content)] = WideChar('*')) or (content[length(content)] = WideChar('+')) then begin freq:= content[length(content)]; dummy:= copy(content,1,length(content)-1); content:= dummy; end; if length(content) = 0 then raise EParserException.create('Parser error.'); if wideChar(content[length(content)]) <> ')' then raise EParserException.create('Parser error.'); XMLTruncRoundBrackets(content,dummy,Error); if Error or (dummy = '') then raise EParserException.create('Parser error.'); content:= dummy; bracketNr:= 0; SeparatorChar:= ','; for i:= 1 to length(content) do begin if (content[i] = ',') and (bracketNr = 0) then begin SeparatorChar:= ','; break; end; {if ...} if (content[i] = '|') and (bracketNr = 0) then begin SeparatorChar:= '|'; break; end; {if ...} if content[i] = '(' then inc(bracketNr); if content[i] = ')' then begin if bracketNr = 0 then raise EParserException.create('Parser error.'); dec(bracketNr); end; end; {for ...} if SeparatorChar = ',' then newNode:= refNode.appendChild(refNode.OwnerCMObject.CreateCMSequenceParticle(freq)) else newNode:= refNode.appendChild(refNode.OwnerCMObject.CreateCMChoiceParticle(freq)); bracketNr:= 0; i:= 0; j:= 1; while i < length(content) do begin inc(i); if content[i] = '(' then inc(bracketNr); if content[i] = ')' then begin if bracketNr = 0 then raise EParserException.create('Parser error.'); dec(bracketNr); end; if ((content[i] = SeparatorChar) and (bracketNr = 0)) or (i = length(content)) then begin if bracketNr > 0 then raise EParserException.create('Parser error.'); if i = length(content) then piece:= XmlTrunc(copy(content,j,i+1-j)) else piece:= XmlTrunc(copy(content,j,i-j)); j:= i+1; if piece[1] = '(' then begin insertChildrenContent(sender,NewNode,piece); end else begin freq:= ''; if (piece[length(piece)] = wideChar('?')) or (piece[length(piece)] = wideChar('*')) or (piece[length(piece)] = wideChar('+')) then begin freq:= piece[length(piece)]; dummy:= copy(piece,1,length(piece)-1); piece:= dummy; end; if not IsXmlName(piece) then raise EParserException.create('Parser error.'); NewNode.appendChild(refNode.OwnerCMObject.CreateCMElementParticle(piece,freq)); end; {if ...} end; {if ...} end; {while ...} end; procedure TXmlDtdBuilder.insertNotationOrEnumerationContent(const sender: TXmlCustomReader; const refCMAttrDefinition: TdomCMAttrDefinition; const contSpec: wideString); var dummy,content,piece: wideString; separator: integer; Error: boolean; begin XMLTruncRoundBrackets(contSpec,content,Error); if Error or (content = '') then raise EParserException.create('Parser error.'); while content <> '' do begin separator:= pos(wideString('|'),content); if separator = 0 then begin piece:= content; content:= ''; end else begin piece:= XMLTrunc(copy(content,1,separator-1)); dummy:= XMLTrunc(copy(content,separator+1,length(content)-separator)); content:= dummy; if content = '' then raise EParserException.create('Parser error.'); end; {if ...} if refCMAttrDefinition.attributeType = 'NOTATION' then begin if not IsXmlName(piece) then raise EParserException.create('Parser error.'); refCMAttrDefinition.appendChild(refCMAttrDefinition.OwnerCMObject.CreateCMNameParticle(piece)); end else begin if not IsXmlNmtoken(piece) then raise EParserException.create('Parser error.'); refCMAttrDefinition.appendChild(refCMAttrDefinition.OwnerCMObject.CreateCMNmtokenParticle(piece)); end; end; {while ...} end; function TXmlDtdBuilder.getExtContentModel: TdomCMExternalObject; begin Result:= FReferenceExtCM; end; function TXmlDtdBuilder.getIntContentModel: TdomCMInternalObject; begin Result:= FReferenceIntCM; end; procedure TXmlDtdBuilder.setExtContentModel(const cm: TdomCMExternalObject); begin if FExtDtdIsActive then raise EParserException.Create('TXmlDtdBuilder -- external DTD is active.'); FReferenceExtCM:= cm; end; procedure TXmlDtdBuilder.setIntContentModel(const cm: TdomCMInternalObject); begin if FIntDtdIsActive then raise EParserException.Create('TXmlDtdBuilder -- internal DTD is active.'); FReferenceIntCM:= cm; end; function TXmlDtdBuilder.attributeDefinition(const sender: TXmlCustomReader; const locator: TdomLocator; aname, attType, bracket, defaultDecl, attValue: wideString): boolean; var newAttDef: TdomCMAttrDefinition; begin if assigned(FOnAttributeDefinition) then FOnAttributeDefinition(sender,locator,aname,attType,bracket,defaultDecl,attValue); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FRefNode) then begin if not (FRefNode.nodeType = ctAttributeList) then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,aname); end else begin try newAttDef:= FRefNode.OwnerCMObject.CreateCMAttributeDefinition(aname,attType,defaultDecl,attValue); try if Bracket <> '' then insertNotationOrEnumerationContent(sender,newAttDef,Bracket); // xxx no well-formedness testing is performed for 'Bracket' FRefNode.appendChild(newAttDef); except if assigned(newAttDef.ParentNode) then newAttDef.ParentNode.RemoveChild(newAttDef); FRefNode.OwnerCMObject.FreeAllCMNodes(TdomCMNode(newAttDef)); raise; end; {try ...} except result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,aname); end; {try ...} end; {if ... else ...} end; if result then if assigned(nextHandler) then result:= nextHandler.attributeDefinition(sender,locator,aname,attType,bracket,defaultDecl,attValue); end; function TXmlDtdBuilder.DTDcomment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; var newComment: TdomCMComment; begin if assigned(FOnDTDcomment) then FOnDTDcomment(sender,locator,data); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FRefNode) then begin try newComment:= FRefNode.OwnerCMObject.CreateCMComment(data); try FRefNode.appendChild(newComment); except if assigned(newComment.ParentNode) then newComment.ParentNode.RemoveChild(newComment); FRefNode.OwnerCMObject.FreeAllCMNodes(TdomCMNode(newComment)); raise; end; {try ...} except result:= sendErrorNotification(sender,ET_INVALID_COMMENT,locator,data); end; {try ...} end; {if assigned(FRefNode) ...} if result then if assigned(nextHandler) then result:= nextHandler.DTDcomment(sender,locator,data); end; function TXmlDtdBuilder.conditionalSection(const sender: TXmlCustomReader; const locator: TdomLocator; includeStmt, data: wideString): boolean; var parser: TXmlToDomParser; begin if assigned(FOnConditionalSection) then FOnConditionalSection(sender,locator,includeStmt,data); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FRefNode) then begin try if (IncludeStmt = 'INCLUDE') and (data <> '') then begin parser:= TXmlToDomParser.create(sender); parser.domImpl:= FRefNode.OwnerCMObject.domImplementation; try if assigned(locator) then parser.extDtdWideStringToDom(data,'',locator.uri,FRefNode) else parser.extDtdWideStringToDom(data,'','',FRefNode); finally parser.free; end; {try ...} end; {if ...} except result:= sendErrorNotification(sender,ET_INVALID_CONDITIONAL_SECTION,locator,name); end; {try ...} end; {if ...} if result then if assigned(nextHandler) then result:= nextHandler.conditionalSection(sender,locator,includeStmt,data); end; function TXmlDtdBuilder.elementTypeDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, data: wideString): boolean; var contSpec: wideString; contspecType: TdomContentspecType; newElementTypeDecl: TdomCMElementTypeDeclaration; begin if assigned(FOnElementTypeDeclaration) then FOnElementTypeDeclaration(sender,locator,aname,data); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FRefNode) then begin contSpec:= XMLTrunc(data); contspecType:= ctChildren; if contSpec = 'EMPTY' then contspecType:= ctEmpty else if contSpec = 'ANY' then contspecType:= ctAny else if pos('#PCDATA',contSpec) > 0 then contspecType:= ctMixed; try newElementTypeDecl:= FRefNode.OwnerCMObject.CreateCMElementTypeDeclaration(aname,contspecType); try FRefNode.appendChild(newElementTypeDecl); except if assigned(newElementTypeDecl.ParentNode) then newElementTypeDecl.ParentNode.RemoveChild(newElementTypeDecl); FRefNode.OwnerCMObject.FreeAllCMNodes(TdomCMNode(newElementTypeDecl)); raise; end; {try ...} try case contspecType of ctMixed: insertMixedContent(sender,newElementTypeDecl,contSpec); ctChildren: insertChildrenContent(sender,newElementTypeDecl,contSpec); end; {case ...} except FRefNode.RemoveChild(newElementTypeDecl); FRefNode.OwnerCMObject.FreeAllCMNodes(TdomCMNode(newElementTypeDecl)); raise; end; {try ...} except result:= sendErrorNotification(sender,ET_INVALID_ELEMENT_DECL,locator,aname); end; {try ...} end; {if ...} if result then if assigned(nextHandler) then result:= nextHandler.elementTypeDeclaration(sender,locator,aname,data); end; function TXmlDtdBuilder.endAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnEndAttListDeclaration) then FOnEndAttListDeclaration(sender,locator); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FRefNode) then begin if not (FRefNode.nodeType = ctAttributeList) then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end else FRefNode:= FRefNode.ParentNode; end; if result then if assigned(nextHandler) then result:= nextHandler.endAttListDeclaration(sender,locator); end; function TXmlDtdBuilder.endExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnEndExtDtd) then FOnEndExtDtd(sender,locator); if FIntDtdIsActive or not FExtDtdIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; FExtDtdIsActive:= false; if result then if assigned(nextHandler) then result:= nextHandler.endExtDtd(sender,locator); end; function TXmlDtdBuilder.endIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnEndIntDtd) then FOnEndIntDtd(sender,locator); if FExtDtdIsActive or not FIntDtdIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; FIntDtdIsActive:= false; if result then if assigned(nextHandler) then result:= nextHandler.endIntDtd(sender,locator); end; function TXmlDtdBuilder.entityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId, notaName: wideString): boolean; var newEntDecl: TdomCMEntityDeclaration; begin if assigned(FOnEntityDeclaration) then FOnEntityDeclaration(sender,locator,aname,entityValue,pubId,sysId,notaName); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FRefNode) then begin try if (pubId = '') and (sysId = '') and (notaName = '') then begin newEntDecl:= FRefNode.OwnerCMObject.CreateCMIntEntityDeclaration(aname,entityValue); end else begin if notaName = '' then newEntDecl:= FRefNode.OwnerCMObject.CreateCMExtEntityDeclaration(aname,pubId,sysId) else newEntDecl:= FRefNode.OwnerCMObject.CreateCMExtUnparsedEntityDeclaration(aname,pubId,sysId,notaName); end; try FRefNode.appendChild(newEntDecl); except if assigned(newEntDecl) then begin if assigned(newEntDecl.ParentNode) then newEntDecl.ParentNode.RemoveChild(newEntDecl); FRefNode.OwnerCMObject.FreeAllCMNodes(TdomCMNode(newEntDecl)); end; raise; end; {try ...} except result:= sendErrorNotification(sender,ET_INVALID_ENTITY_DECL,locator,aname); end; {try ...} end; {if ...} if result then if assigned(nextHandler) then result:= nextHandler.entityDeclaration(sender,locator,aname,entityValue,pubId,sysId,notaName); end; function TXmlDtdBuilder.notationDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId: wideString): boolean; var newNotaDecl: TdomCMNotationDeclaration; begin if assigned(FOnNotationDeclaration) then FOnNotationDeclaration(sender,locator,aname,pubId,sysId); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FRefNode) then begin try newNotaDecl:= FRefNode.OwnerCMObject.CreateCMNotationDeclaration(aname,pubId,sysId); try FRefNode.appendChild(newNotaDecl); except if assigned(newNotaDecl) then begin if assigned(newNotaDecl.ParentNode) then newNotaDecl.ParentNode.RemoveChild(newNotaDecl); FRefNode.OwnerCMObject.FreeAllCMNodes(TdomCMNode(newNotaDecl)); end; raise; end; {try ...} except result:= sendErrorNotification(sender,ET_INVALID_NOTATION_DECL,locator,aname); end; {try ...} end; {if ...} if result then if assigned(nextHandler) then result:= nextHandler.notationDeclaration(sender,locator,aname,pubId,sysId); end; function TXmlDtdBuilder.parameterEntityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId: wideString): boolean; var newParamEntDecl: TdomCMParameterEntityDeclaration; begin if assigned(FOnParameterEntityDeclaration) then FOnParameterEntityDeclaration(sender,locator,aname,entityValue,pubId,sysId); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if FExtDtdIsActive then begin if extContentModel.hasPEDeclaration(aname) then result:= sendErrorNotification(sender,ET_DOUBLE_PARAMETER_ENTITY_DECL,locator,aname); end else if FIntDtdIsActive then begin if intContentModel.hasPEDeclaration(aname) then result:= sendErrorNotification(sender,ET_DOUBLE_PARAMETER_ENTITY_DECL,locator,aname); end; if result then begin if assigned(FRefNode) then begin try if (pubId = '') and (sysId = '') then newParamEntDecl:= FRefNode.OwnerCMObject.CreateCMIntParameterEntityDeclaration(aname,entityValue) else newParamEntDecl:= FRefNode.OwnerCMObject.CreateCMExtParameterEntityDeclaration(aname,pubId,sysId); try FRefNode.appendChild(newParamEntDecl); except if assigned(newParamEntDecl) then begin if assigned(newParamEntDecl.ParentNode) then newParamEntDecl.ParentNode.RemoveChild(newParamEntDecl); FRefNode.OwnerCMObject.FreeAllCMNodes(TdomCMNode(newParamEntDecl)); end; raise; end; {try ...} except result:= sendErrorNotification(sender,ET_INVALID_ENTITY_DECL,locator,aname); end; {try ...} end; {if ...} end; {if ...} if result then if assigned(nextHandler) then result:= nextHandler.parameterEntityDeclaration(sender,locator,aname,entityValue,pubId,sysId); end; function TXmlDtdBuilder.parameterEntityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; const SPACE: wideString = #$0020; var error: TXmlErrorType; error2: boolean; newParamEntRef: TdomCMParameterEntityReference; parser: TXmlToDomParser; replText, value: wideString; begin if assigned(FOnParameterEntityRef) then FOnParameterEntityRef(sender,locator,aname); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FRefNode) then begin if FIntDtdIsActive then begin newParamEntRef:= FRefNode.OwnerCMObject.CreateCMParameterEntityReference(aname); try FRefNode.appendChild(newParamEntRef); except if assigned(newParamEntRef.ParentNode) then newParamEntRef.ParentNode.RemoveChild(newParamEntRef); FRefNode.OwnerCMObject.FreeAllCMNodes(TdomCMNode(newParamEntRef)); result:= sendErrorNotification(sender,ET_INVALID_ENTITY_NAME,locator,aname); end; {try ...} end; if FExtDtdIsActive then begin resolvePE(aname,value,error); if error = ET_NONE then begin try ResolveCharRefsAndPERefs(value,replText,error2); except error2:= true; end; if error2 then begin result:= sendErrorNotification(sender,ET_INVALID_ENTITY_DECL,locator,aname); end else begin try parser:= TXmlToDomParser.create(sender); parser.domImpl:= FRefNode.OwnerCMObject.domImplementation; try if assigned(locator) then parser.extDtdWideStringToDom(concat(SPACE,replText,SPACE),'',locator.uri,FRefNode) else parser.extDtdWideStringToDom(concat(SPACE,replText,SPACE),'','',FRefNode); // SPACE is required by XML 1.0 Spec, § 4.4.8 finally parser.free; end; {try ...} except result:= sendErrorNotification(sender,ET_INVALID_ENTITY_NAME,locator,aname); end; {try ...} end; {if ... else ...} end else begin result:= sendErrorNotification(sender,error,locator,aname); end; end; {if FExtDtdIsActive ...} end; {if ...} if result then if assigned(nextHandler) then result:= nextHandler.parameterEntityRef(sender,locator,aname); end; function TXmlDtdBuilder.DTDprocessingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; var newPI: TdomCMProcessingInstruction; begin if assigned(FOnDTDprocessingInstruction) then FOnDTDprocessingInstruction(sender,locator,targ,data); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FRefNode) then begin try newPI:= FRefNode.OwnerCMObject.CreateCMProcessingInstruction(targ,data); try FRefNode.appendChild(newPI); except if assigned(newPI.ParentNode) then newPI.ParentNode.RemoveChild(newPI); FRefNode.OwnerCMObject.FreeAllCMNodes(TdomCMNode(newPI)); raise; end; except result:= sendErrorNotification(sender,ET_INVALID_PROCESSING_INSTRUCTION,locator,targ); end; end; {if assigned(FRefNode) ...} if result then if assigned(nextHandler) then result:= nextHandler.DTDprocessingInstruction(sender,locator,targ,data); end; function TXmlDtdBuilder.startAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; var newAttList: TdomCMAttrList; begin if assigned(FOnStartAttListDeclaration) then FOnStartAttListDeclaration(sender,locator,aname); if not (FExtDtdIsActive or FIntDtdIsActive) then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FRefNode) then begin try newAttList:= FRefNode.OwnerCMObject.CreateCMAttributeList(aname); try FRefNode.appendChild(newAttList); except if assigned(newAttList.ParentNode) then newAttList.ParentNode.RemoveChild(newAttList); FRefNode.OwnerCMObject.FreeAllCMNodes(TdomCMNode(newAttList)); raise; end; {try ...} except result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,aname); end; {try ...} FRefNode:= newAttList; end; {if ...} if result then if assigned(nextHandler) then result:= nextHandler.startAttListDeclaration(sender,locator,aname); end; function TXmlDtdBuilder.startExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString): boolean; begin if assigned(FOnStartExtDtd) then FOnStartExtDtd(sender,locator,version,encName); if FIntDtdIsActive or FExtDtdIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; FExtDtdIsActive:= true; FRefNode:= FReferenceExtCM; if assigned(FReferenceExtCM) then begin FReferenceExtCM.publicId:= ''; if assigned(locator) then FReferenceExtCM.systemId:= locator.uri else FReferenceExtCM.systemId:= ''; FReferenceExtCM.version:= version; FReferenceExtCM.encoding:= encName; end; if result then if assigned(nextHandler) then result:= nextHandler.startExtDtd(sender,locator,version,encName); end; function TXmlDtdBuilder.startIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnStartIntDtd) then FOnStartIntDtd(sender,locator); if FIntDtdIsActive or FExtDtdIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; FIntDtdIsActive:= true; FRefNode:= FReferenceIntCM; if assigned(FReferenceIntCM) then begin if assigned(locator) then FReferenceIntCM.publicId:= '' else FReferenceIntCM.systemId:= locator.uri; end; if result then if assigned(nextHandler) then result:= nextHandler.startIntDtd(sender,locator); end; procedure TXmlDtdBuilder.notifyReset; begin FRefNode:= nil; FExtDtdIsActive:= false; FIntDtdIsActive:= false; if assigned(nextHandler) then nextHandler.notifyReset; end; // ++++++++++++++++++++++++++ TXmlCMBuilder +++++++++++++++++++++++++++ constructor TXmlCMBuilder.create(AOwner: TComponent); begin inherited create(AOwner); FContentModel:= nil; FIsActive:= false; end; procedure TXmlCMBuilder.CDataNormalization(const s: wideString; var result: wideString; var error: boolean); const TAB: WideChar = #$9; // Horizontal Tabulation LF: WideChar = #$A; // Line Feed CR: WideChar = #$D; // Carriage Return SPACE: WideChar = #$20; // ' ' var i,j,indexpos: integer; SChar, SChar2: widechar; name,ref: wideString; content: TdomCustomStr; Entity: TdomCMEntity; begin Result:= ''; Error:= false; content:= TdomCustomStr.create; try i:= 1; while i <= length(S) do begin SChar:= WideChar((PWideChar(S)+i-1)^); if IsUtf16LowSurrogate(sChar) then raise EConvertError.CreateFmt('%S must not start with a UTF-16 low surrogate.',[S]); if IsUtf16HighSurrogate(SChar) then begin if i+1 > length(s) then raise EConvertError.CreateFmt('%S must not end with a UTF-16 high surrogate.',[S]); inc(i); content.addWideChar(SChar); SChar:= WideChar((PWideChar(S)+i-1)^); if not IsUtf16LowSurrogate(SChar) then raise EConvertError.CreateFmt('%S contains an UTF-16 high surrogate without its corresponding low surrogate.',[S]); end; if not IsXmlChar(sChar) then raise EConvertError.CreateFmt('%S contains an invalid character.',[S]); if SChar = '&' then begin // Reference? indexpos:= -1; for j:= i+1 to length(S) do begin SChar2:= WideChar((PWideChar(S)+j-1)^); if SChar2 = ';' then begin indexpos:= j; break; end; end; if indexpos = -1 then raise EConvertError.CreateFmt('%S contains an ''&'' without a '';''.',[S]); ref:= copy(S,i,j-i+1); if IsXmlEntityRef(ref) then begin name:= copy(ref,2,length(ref)-2); Entity:= FContentModel.Entities.GetNamedItem(name); if assigned(Entity) then begin try content.addWideString(Entity.normalizedValue); except error:= true; end; end else begin content.addWideString(ref); error:= true; end; end else if IsXmlCharRef(ref) then begin content.addWideString(XmlCharRefToStr(ref)); end else raise EConvertError.CreateFmt('%S contains an invalid reference.',[S]); i:= j; end else if (SChar = TAB) or (SChar = LF) or (SChar = CR) // White space? then content.addWideChar(SPACE) else content.addWideChar(SChar); inc(i); end; {while ...} Result:= content.value; finally content.free; end; end; function TXmlCMBuilder.getContentModel: TdomCMObject; begin Result:= FContentModel; end; procedure TXmlCMBuilder.insertMixedContent(const sender: TXmlCustomReader; const refNode: TdomCMNode; const contSpec: wideString); var freq, dummy, content,piece: wideString; separator: integer; Error: boolean; newNode: TdomCMNode; begin content:= XMLTrunc(contSpec); freq:= ''; if (content[length(content)] = '*') then begin freq:= '*'; dummy:= copy(content,1,length(content)-1); content:= dummy; end; if length(content) = 0 then raise EParserException.create('Parser error.'); if wideChar(content[length(content)]) <> ')' then raise EParserException.create('Parser error.'); XMLTruncRoundBrackets(content,dummy,Error); if Error or (dummy = '') then raise EParserException.create('Parser error.'); content:= dummy; newNode:= refNode.appendChild(refNode.OwnerCMObject.CreateCMPcdataChoiceParticle); if content = '#PCDATA' then exit; if freq = '' then raise EParserException.create('Parser error.'); separator:= pos(wideString('|'),content); if separator = 0 then raise EParserException.create('Parser error.'); dummy:= XMLTrunc(copy(content,separator+1,length(content)-separator)); content:= dummy; while content <> '' do begin separator:= pos(wideString('|'),content); if separator = 0 then begin piece:= content; content:= ''; end else begin piece:= XMLTrunc(copy(content,1,separator-1)); dummy:= XMLTrunc(copy(content,separator+1,length(content)-separator)); content:= dummy; if content = '' then raise EParserException.create('Parser error.'); end; {if ...} if not IsXmlName(piece) then raise EParserException.create('Parser error.'); newNode.appendChild(newNode.OwnerCMObject.CreateCMElementParticle(piece,'')); end; {while ...} end; procedure TXmlCMBuilder.insertChildrenContent(const sender: TXmlCustomReader; const refNode: TdomCMNode; const contSpec: wideString); var piece,dummy,content,freq: wideString; SeparatorChar: WideChar; j,i,bracketNr: integer; newNode: TdomCMNode; Error: boolean; begin content:= XMLTrunc(contSpec); freq:= ''; if (content[length(content)] = WideChar('?')) or (content[length(content)] = WideChar('*')) or (content[length(content)] = WideChar('+')) then begin freq:= content[length(content)]; dummy:= copy(content,1,length(content)-1); content:= dummy; end; if length(content) = 0 then raise EParserException.create('Parser error.'); if wideChar(content[length(content)]) <> ')' then raise EParserException.create('Parser error.'); XMLTruncRoundBrackets(content,dummy,Error); if Error or (dummy = '') then raise EParserException.create('Parser error.'); content:= dummy; bracketNr:= 0; SeparatorChar:= ','; for i:= 1 to length(content) do begin if (content[i] = ',') and (bracketNr = 0) then begin SeparatorChar:= ','; break; end; {if ...} if (content[i] = '|') and (bracketNr = 0) then begin SeparatorChar:= '|'; break; end; {if ...} if content[i] = '(' then inc(bracketNr); if content[i] = ')' then begin if bracketNr = 0 then raise EParserException.create('Parser error.'); dec(bracketNr); end; end; {for ...} if SeparatorChar = ',' then newNode:= refNode.appendChild(refNode.OwnerCMObject.CreateCMSequenceParticle(freq)) else newNode:= refNode.appendChild(refNode.OwnerCMObject.CreateCMChoiceParticle(freq)); bracketNr:= 0; i:= 0; j:= 1; while i < length(content) do begin inc(i); if content[i] = '(' then inc(bracketNr); if content[i] = ')' then begin if bracketNr = 0 then raise EParserException.create('Parser error.'); dec(bracketNr); end; if ((content[i] = SeparatorChar) and (bracketNr = 0)) or (i = length(content)) then begin if bracketNr > 0 then raise EParserException.create('Parser error.'); if i = length(content) then piece:= XmlTrunc(copy(content,j,i+1-j)) else piece:= XmlTrunc(copy(content,j,i-j)); j:= i+1; if piece[1] = '(' then begin insertChildrenContent(sender,NewNode,piece); end else begin freq:= ''; if (piece[length(piece)] = wideChar('?')) or (piece[length(piece)] = wideChar('*')) or (piece[length(piece)] = wideChar('+')) then begin freq:= piece[length(piece)]; dummy:= copy(piece,1,length(piece)-1); piece:= dummy; end; if not IsXmlName(piece) then raise EParserException.create('Parser error.'); NewNode.appendChild(refNode.OwnerCMObject.CreateCMElementParticle(piece,freq)); end; {if ...} end; {if ...} end; {while ...} end; procedure TXmlCMBuilder.insertNotationOrEnumerationContent(const sender: TXmlCustomReader; const refCMAttribute: TdomCMAttribute; const contSpec: wideString); var dummy,content,piece: wideString; separator: integer; Error: boolean; begin XMLTruncRoundBrackets(contSpec,content,Error); if Error or (content = '') then raise EParserException.create('Parser error.'); while content <> '' do begin separator:= pos(wideString('|'),content); if separator = 0 then begin piece:= content; content:= ''; end else begin piece:= XMLTrunc(copy(content,1,separator-1)); dummy:= XMLTrunc(copy(content,separator+1,length(content)-separator)); content:= dummy; if content = '' then raise EParserException.create('Parser error.'); end; {if ...} if refCMAttribute.attributeType = 'NOTATION' then begin if not IsXmlName(piece) then raise EParserException.create('Parser error.'); refCMAttribute.appendChild(refCMAttribute.OwnerCMObject.CreateCMNameParticle(piece)); end else begin if not IsXmlNmtoken(piece) then raise EParserException.create('Parser error.'); refCMAttribute.appendChild(refCMAttribute.OwnerCMObject.CreateCMNmtokenParticle(piece)); end; end; {while ...} end; procedure TXmlCMBuilder.resolveCharRefsAndPERefs(const s: wideString; var result: wideString; var error: boolean); var i,j,indexpos: integer; SChar, SChar2: widechar; name,ref,value: wideString; content: TdomCustomStr; errType: TXmlErrorType; begin Result:= ''; Error:= false; content:= TdomCustomStr.create; try i:= 1; while i <= length(S) do begin SChar:= WideChar((PWideChar(S)+i-1)^); if IsUtf16LowSurrogate(sChar) then raise EConvertError.CreateFmt('%S must not start with a UTF-16 low surrogate.',[S]); if IsUtf16HighSurrogate(SChar) then begin if i+1 > length(s) then raise EConvertError.CreateFmt('%S must not end with a UTF-16 high surrogate.',[S]); inc(i); content.addWideChar(SChar); SChar:= WideChar((PWideChar(S)+i-1)^); if not IsUtf16LowSurrogate(SChar) then raise EConvertError.CreateFmt('%S contains an UTF-16 high surrogate without its corresponding low surrogate.',[S]); end; if not IsXmlChar(sChar) then raise EConvertError.CreateFmt('%S contains an invalid character.',[S]); if SChar = '&' then begin {Reference?} indexpos:= -1; for j:= i+1 to length(S) do begin SChar2:= WideChar((PWideChar(S)+j-1)^); if SChar2 = ';' then begin indexpos:= j; break; end; end; if indexpos = -1 then raise EConvertError.CreateFmt('%S contains an ''&'' without a '';''.',[S]); ref:= copy(S,i,j-i+1); if IsXmlEntityRef(ref) then begin content.addWideString(ref); end else if IsXmlCharRef(ref) then begin content.addWideString(XmlCharRefToStr(ref)); end else raise EConvertError.CreateFmt('%S contains an invalid reference.',[S]); i:= j; end else if SChar = '%' then begin {PEReference?} indexpos:= -1; for j:= i+1 to length(S) do begin SChar2:= WideChar((PWideChar(S)+j-1)^); if SChar2 = ';' then begin indexpos:= j; break; end; end; if indexpos = -1 then raise EConvertError.CreateFmt('%S contains an ''%'' without a '';''.',[S]); ref:= copy(S,i,j-i+1); if IsXmlPEReference(ref) then begin name:= copy(ref,2,length(ref)-2); resolvePE(name,value,errType); if errType <> ET_NONE then raise EConvertError.CreateFmt('%S contains an invalid parameter entity reference.',[S]); content.addWideString(value); end else raise EConvertError.CreateFmt('%S contains an invalid parameter entity reference.',[S]); i:= j; end else content.addWideChar(SChar); inc(i); end; {while ...} Result:= content.value; finally content.free; end; end; procedure TXmlCMBuilder.setContentModel(const cm: TdomCMObject); begin if FIsActive then raise EParserException.Create('TXmlCMBuilder -- Content Model is active.'); FContentModel:= cm; end; function TXmlCMBuilder.resolvePE( PEReferenceName: wideString; var PEValue: wideString; var error: TXmlErrorType): boolean; begin if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; FContentModel.getValueOfPE(PEReferenceName,PEValue,error); end; function TXmlCMBuilder.attributeDefinition(const sender: TXmlCustomReader; const locator: TdomLocator; aname, attType, bracket, defaultDecl, attValue: wideString): boolean; const LT: WideChar = #60; // '<' var error: boolean; newCMAttribute: TdomCMAttribute; replText: wideString; begin if assigned(FOnAttributeDefinition) then FOnAttributeDefinition(sender,locator,aname,attType,bracket,defaultDecl,attValue); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FContentModel) then begin if FCurrentAttListName = '' then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,aname); end else begin if assigned(FContentModel.attributes.GetNamedItem(FCurrentAttListName,aname)) then begin result:= sendErrorNotification(sender,ET_DOUBLE_ATTDEF,locator,aname); end else begin try CDataNormalization(attValue,replText,error); except result:= sendErrorNotification(sender,ET_INVALID_ENTITY_DECL,locator,attValue); end; {try ...} if result and error then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,aname); end; // WFC: No < in Attribute Values (XML 1.0, § 3.3.2) if result and (pos(LT,replText) > 0) then begin result:= sendErrorNotification(sender,ET_LT_IN_ATTRIBUTE_VALUE,locator,aname); end; if result then begin newCMAttribute:= FContentModel.CreateCMAttribute(FCurrentAttListName,aname,attType,defaultDecl,replText); try if Bracket <> '' then insertNotationOrEnumerationContent(sender,newCMAttribute,Bracket); // xxx no well-formedness testing is performed for 'Bracket' except FContentModel.FreeAllCMNodes(TdomCMNode(newCMAttribute)); result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,aname); end; {try ...} if assigned(newCMAttribute) then FContentModel.Attributes.appendNamedItem(newCMAttribute); end; {if ...} end; {if ... else ...} end; {if ... else ...} end; {if ...} if result then if assigned(nextHandler) then result:= nextHandler.attributeDefinition(sender,locator,aname,attType,bracket,defaultDecl,attValue); end; function TXmlCMBuilder.DTDcomment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; begin if assigned(FOnDTDcomment) then FOnDTDcomment(sender,locator,data); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FContentModel) and (FCurrentAttListName <> '') then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end; {if ...} if result then if assigned(nextHandler) then result:= nextHandler.DTDcomment(sender,locator,data); end; function TXmlCMBuilder.conditionalSection(const sender: TXmlCustomReader; const locator: TdomLocator; includeStmt, data: wideString): boolean; begin if assigned(FOnConditionalSection) then FOnConditionalSection(sender,locator,includeStmt,data); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FContentModel) and (FCurrentAttListName <> '') then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end; {if ...} if result then if assigned(nextHandler) then result:= nextHandler.conditionalSection(sender,locator,includeStmt,data); end; function TXmlCMBuilder.elementTypeDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, data: wideString): boolean; var contSpec: wideString; contspecType: TdomContentspecType; newElementTypeDecl: TdomCMElementTypeDeclaration; begin if assigned(FOnElementTypeDeclaration) then FOnElementTypeDeclaration(sender,locator,aname,data); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FContentModel) then begin if FCurrentAttListName <> '' then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end else if not IsXmlName(aname) then begin result:= sendErrorNotification(sender,ET_INVALID_ELEMENT_DECL,locator,aname); end else if assigned(FContentModel.elementTypes.GetNamedItem(aname)) then begin result:= sendErrorNotification(sender,ET_DUPLICATE_ELEMENT_TYPE_DECL,locator,aname); end else begin contSpec:= XMLTrunc(data); contspecType:= ctChildren; if contSpec = 'EMPTY' then contspecType:= ctEmpty else if contSpec = 'ANY' then contspecType:= ctAny else if pos('#PCDATA',contSpec) > 0 then contspecType:= ctMixed; try newElementTypeDecl:= FContentModel.CreateCMElementTypeDeclaration(aname,contspecType); try case contspecType of ctMixed: insertMixedContent(sender,newElementTypeDecl,contSpec); ctChildren: insertChildrenContent(sender,newElementTypeDecl,contSpec); end; {case ...} FContentModel.elementTypes.setNamedItem(newElementTypeDecl); except FContentModel.FreeAllCMNodes(TdomCMNode(newElementTypeDecl)); raise; end; {try ...} except result:= sendErrorNotification(sender,ET_INVALID_ELEMENT_DECL,locator,aname); end; {try ...} end; end; {if ...} if result then if assigned(nextHandler) then result:= nextHandler.elementTypeDeclaration(sender,locator,aname,data); end; function TXmlCMBuilder.endAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnEndAttListDeclaration) then FOnEndAttListDeclaration(sender,locator); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FContentModel) then begin if FCurrentAttListName = '' then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,FCurrentAttListName); end; FCurrentAttListName:= ''; end; {if ...} if result then if assigned(nextHandler) then result:= nextHandler.endAttListDeclaration(sender,locator); end; function TXmlCMBuilder.endExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnEndExtDtd) then FOnEndExtDtd(sender,locator); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FContentModel) then begin if FCurrentAttListName <> '' then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end else begin FIsActive:= false; end; end; {if ...} if result then if assigned(nextHandler) then result:= nextHandler.endExtDtd(sender,locator); end; function TXmlCMBuilder.endIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnEndExtDtd) then FOnEndExtDtd(sender,locator); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FContentModel) then begin if FCurrentAttListName <> '' then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end else begin FIsActive:= false; end; end; {if ...} if result then if assigned(nextHandler) then result:= nextHandler.endExtDtd(sender,locator); end; function TXmlCMBuilder.entityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, literalValue, pubId, sysId, notaName: wideString): boolean; var newEntity: TdomCMEntity; begin if assigned(FOnEntityDeclaration) then FOnEntityDeclaration(sender,locator,aname,literalValue,pubId,sysId,notaName); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FContentModel) then begin if FCurrentAttListName <> '' then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end else begin if assigned(FContentModel.Entities.GetNamedItem(aname)) then begin result:= sendErrorNotification(sender,ET_DOUBLE_ENTITY_DECL,locator,aname); end else begin if notaName = '' then begin if (pubId = '') and (sysId = '') then begin // Entity is internal newEntity:= FContentModel.createCMIntEntity(aname,literalValue); FContentModel.Entities.appendNamedItem(newEntity); if newEntity.isUnusable then result:= sendErrorNotification(sender,ET_UNUSABLE_ENTITY_DECL,locator,aname); end else begin // Entity is external parsed newEntity:= FContentModel.createCMExtParsedEntity(aname,pubId,sysId); FContentModel.Entities.appendNamedItem(newEntity); end; {if ... else ...} end else begin // Entity is external unparsed newEntity:= FContentModel.createCMExtUnparsedEntity(aname,pubId,sysId,notaName); FContentModel.Entities.appendNamedItem(newEntity); end; {if notaName <> '' ... else ...} end; {if assigned ... else ...} end; {if ... else ...} end; {if ...} if result then if assigned(nextHandler) then result:= nextHandler.entityDeclaration(sender,locator,aname,literalValue,pubId,sysId,notaName); end; function TXmlCMBuilder.notationDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId: wideString): boolean; var newNotation: TdomCMNotation; begin if assigned(FOnNotationDeclaration) then FOnNotationDeclaration(sender,locator,aname,pubId,sysId); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FContentModel) then begin if FCurrentAttListName <> '' then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end else begin if assigned(FContentModel.Notations.GetNamedItem(aname)) then begin result:= sendErrorNotification(sender,ET_DUPLICATE_NOTATION_DECL,locator,aname); end else begin try newNotation:= FContentModel.CreateCMNotation(aname,pubId,sysId); FContentModel.Notations.SetNamedItem(newNotation); except result:= sendErrorNotification(sender,ET_INVALID_NOTATION_DECL,locator,aname); end; {try ...} end; end; {if ...} end; {if ...} if result then if assigned(nextHandler) then result:= nextHandler.notationDeclaration(sender,locator,aname,pubId,sysId); end; function TXmlCMBuilder.parameterEntityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; const SPACE: wideString = #$0020; var dtdAnalyzer: TXmlCMAnalyzer; error: TXmlErrorType; error2: boolean; replText,value: wideString; begin if assigned(FOnParameterEntityRef) then FOnParameterEntityRef(sender,locator,aname); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FContentModel) then begin if FCurrentAttListName <> '' then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end else begin resolvePE(aname,value,error); if error = ET_NONE then begin try ResolveCharRefsAndPERefs(value,replText,error2); if error2 then begin result:= sendErrorNotification(sender,ET_ENTITY_DECL_NOT_FOUND,locator,aname); end else begin dtdAnalyzer:= TXmlCMAnalyzer.create(nil); if assigned(sender) then dtdAnalyzer.DOMImpl:= sender.domImpl; try try dtdAnalyzer.analyzeIntDTDStr(replText,FContentModel); finally dtdAnalyzer.free; end; except result:= sendErrorNotification(sender,ET_INVALID_ENTITY_NAME,locator,aname); end; end; except result:= sendErrorNotification(sender,ET_ENTITY_DECL_NOT_FOUND,locator,aname); end; {try ...} end else begin result:= sendErrorNotification(sender,error,locator,aname); end; end; {if ... else ...} end; {if ...} if result then if assigned(nextHandler) then result:= nextHandler.parameterEntityRef(sender,locator,aname); end; function TXmlCMBuilder.DTDprocessingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; begin if assigned(FOnDTDprocessingInstruction) then FOnDTDprocessingInstruction(sender,locator,targ,data); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FContentModel) and (FCurrentAttListName <> '') then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,''); end; if result then if assigned(nextHandler) then result:= nextHandler.DTDprocessingInstruction(sender,locator,targ,data); end; function TXmlCMBuilder.startAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; begin if assigned(FOnStartAttListDeclaration) then FOnStartAttListDeclaration(sender,locator,aname); if not FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; if assigned(FContentModel) then begin if FCurrentAttListName <> '' then begin result:= sendErrorNotification(sender,ET_INVALID_ATTRIBUTE_DECL,locator,FCurrentAttListName); end else begin FCurrentAttListName:= aname; end; {if ... else ...} end; {if ...} if result then if assigned(nextHandler) then result:= nextHandler.startAttListDeclaration(sender,locator,aname); end; function TXmlCMBuilder.startExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString): boolean; begin if assigned(FOnStartExtDtd) then FOnStartExtDtd(sender,locator,version,encName); if FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; FCurrentAttListName:= ''; FIsActive:= true; if result then if assigned(nextHandler) then result:= nextHandler.startExtDtd(sender,locator,version,encName); end; function TXmlCMBuilder.startIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnStartIntDtd) then FOnStartIntDtd(sender,locator); if FIsActive then begin raise EParserException.create('Internal Parser Exception'); end; result:= true; FCurrentAttListName:= ''; FIsActive:= true; if result then if assigned(nextHandler) then result:= nextHandler.startIntDtd(sender,locator); end; procedure TXmlCMBuilder.notifyReset; begin FCurrentAttListName:= ''; FIsActive:= false; if assigned(nextHandler) then nextHandler.notifyReset; end; // ++++++++++++++++++++++++ TXmlStreamBuilder ++++++++++++++++++++++++++ constructor TXmlStreamBuilder.create(aOwner: TComponent); begin inherited; FCurrentEncodingType:= etUTF8; FDefaultEncodingType:= etUTF8; FNewLine:= nltCRLF; end; procedure TXmlStreamBuilder.setDefaultEncoding(const value: wideString); var newEncodingType: TdomEncodingType; begin if FDefaultEncoding = value then exit; newEncodingType:= StrToEncoding(value); case newEncodingType of etLatin1,etUTF8,etUTF16BE: begin FDefaultEncodingType:= newEncodingType; FDefaultEncoding:= value; FCurrentEncodingType:= newEncodingType; end; else raise ENot_Supported_Err.create('Encoding not supported error.'); end; end; procedure TXmlStreamBuilder.setDestination(const value: TStream); begin FDestination:= value; end; procedure TXmlStreamBuilder.setNewLine(const value: TdomNewLineType); begin FNewLine:= value; end; function TXmlStreamBuilder.writeWideString(const sender: TXmlCustomReader; const locator: TdomLocator; const xmlStrg: wideString): boolean; const CR_char: char = #13; LF_char: char = #10; CRLF_str: string = #13#10; var S: string; C: Char; WC: WideChar; highSurrogate, lowSurrogate: WideChar; i: integer; begin if not assigned(destination) then raise EParserException.create('Destination stream not specified'); result:= true; case FCurrentEncodingType of etUTF8: try S:= UTF16BEToUTF8Str(xmlStrg,false); destination.writeBuffer(pointer(S)^, Length(S)); except sendErrorNotification(sender,ET_INVALID_CHARACTER,locator,xmlStrg); result:= false; exit; end; etUTF16BE: destination.writeBuffer(pointer(XMLStrg)^, Length(XMLStrg) shl 1); etLatin1: begin i:= 1; while i <= length(XMLStrg) do begin WC:= XMLStrg[i]; case Word(WC) of $000A: // LF case FNewLine of nltCRLF: destination.writeBuffer(pointer(CRLF_str)^,2); ntlCR: destination.writeBuffer(CR_char,1); ntlLF: destination.writeBuffer(LF_char,1); end; $D800..$DBFF: // High surrogate of Unicode character [$10000..$10FFFF] begin if i = length(XMLStrg) then begin // End of wideString --> No low surrogate found sendErrorNotification(sender,ET_INVALID_CHARACTER,locator,xmlStrg); result:= false; exit; end; highSurrogate:= XMLStrg[i]; inc(i); lowSurrogate:= XMLStrg[i]; if not IsUtf16LowSurrogate(lowSurrogate) then begin // No low surrogate found sendErrorNotification(sender,ET_INVALID_CHARACTER,locator,xmlStrg); result:= false; exit; end; S:= concat('&#x',IntToHex(UTF16SurrogateToInt(highSurrogate,lowSurrogate),1),';'); destination.writeBuffer(pointer(S)^, Length(S)); end; $DC00..$DFFF: // low surrogate begin sendErrorNotification(sender,ET_INVALID_CHARACTER,locator,xmlStrg); result:= false; exit; end; else try C:= UTF16ToIso8859_1Char(WC); destination.writeBuffer(C,1); except on EConvertError do begin S:= concat('&#x',IntToHex(word(WC),1),';'); destination.writeBuffer(pointer(S)^, Length(S)); end; end; end; {case ...} inc(i); end; {while ...} end; end; {case ...} end; function TXmlStreamBuilder.writeWideStrings(const sender: TXmlCustomReader; const locator: TdomLocator; const xmlStrgs: array of wideString): boolean; var i: longint; begin result:= true; for i:= 0 to High(xmlStrgs) do begin result:= writeWideString(sender,locator,xmlStrgs[i]); if not result then exit; end; end; function TXmlStreamBuilder.CDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; begin if assigned(FOnCDATA) then FOnCDATA(sender,locator,data); result:= writeWideStrings(sender,locator,['']); if result then if assigned(nextHandler) then result:= nextHandler.CDATA(sender,locator,data); end; function TXmlStreamBuilder.charRef(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; begin if assigned(FOnCharRef) then FOnCharRef(sender,locator,data); //result:= writeWideStrings(sender,locator,['']); AleF result:= writeWideStrings(sender,locator,[data]); if result then if assigned(nextHandler) then result:= nextHandler.charRef(sender,locator,data); end; function TXmlStreamBuilder.comment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; begin if assigned(FOnComment) then FOnComment(sender,locator,data); result:= writeWideStrings(sender,locator,['']); if result then if assigned(nextHandler) then result:= nextHandler.comment(sender,locator,data); end; function TXmlStreamBuilder.doctype(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId, data: wideString): boolean; begin if assigned(FOnDoctype) then FOnDoctype(sender,locator,aname,pubId,sysId,data); result:= writeWideStrings(sender,locator, [' '') or (sysId <> '')) then result:= writeWideString(sender,locator, xmlAnalysePubSysId(pubId,sysId,'')); if result and (Length(data) = 0) then result:= writeWideString(sender,locator,'>') else result:= writeWideStrings(sender,locator, ['[',data,']>']); if result then if assigned(nextHandler) then result:= nextHandler.doctype(sender,locator,aname,pubId,sysId,data); end; function TXmlStreamBuilder.endDocument(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnEndDocument) then FOnEndDocument(sender,locator); FCurrentEncodingType:= defaultEncodingType; if assigned(nextHandler) then result:= nextHandler.endDocument(sender,locator) else result:= true; end; function TXmlStreamBuilder.endElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString): boolean; begin if assigned(FOnEndElement) then FOnEndElement(sender,locator,namespaceURI,tagName); result:= writeWideStrings(sender,locator,['']); if result then if assigned(nextHandler) then result:= nextHandler.endElement(sender,locator,namespaceURI,tagName); end; function TXmlStreamBuilder.endPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix: wideString): boolean; begin if assigned(FOnEndPrefixMapping) then FOnEndPrefixMapping(sender,locator,prefix); if assigned(nextHandler) then result:= nextHandler.endPrefixMapping(sender,locator,prefix) else result:= true; end; function TXmlStreamBuilder.entityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; begin if assigned(FOnEntityRef) then FOnEntityRef(sender,locator,aname); result:= writeWideStrings(sender,locator,['&', aname, ';']); if result then if assigned(nextHandler) then result:= nextHandler.entityRef(sender,locator,aname); end; function TXmlStreamBuilder.PCDATA(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; var i: integer; content: TdomCustomStr; modifiedData: wideString; begin if assigned(FOnPCDATA) then FOnPCDATA(sender,locator,data); content:= TdomCustomStr.create; try for i:= 1 to length(data) do begin case ord(data[i]) of { 38: content.addWideString('&');//amp;'); // Ampersand ('&') 60: content.addWideString('<');//lt;'); // Less than ('<') 62: content.addWideString('>');//gt;'); // Greater than ('>') 13: content.addWideString(' '); // Carriage Return (CR)} { 38: content.addWideString('&'); // Ampersand ('&') 60: content.addWideString('<'); // Less than ('<') 62: content.addWideString('>'); // Greater than ('>') 13: content.addWideString(' '); // Carriage Return (CR)} 38: content.addWideString('&'); // Ampersand ('&') 60: content.addWideString('<'); // Less than ('<') 62: content.addWideString('>'); // Greater than ('>') 13: content.addWideString(' '); // Carriage Return (CR) else content.addWideChar(data[i]); end; end; modifiedData:= content.value; finally content.free; end; result:= writeWideString(sender,locator,modifiedData); if result then if assigned(nextHandler) then result:= nextHandler.PCDATA(sender,locator,data); end; function TXmlStreamBuilder.processingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; begin if assigned(FOnProcessingInstruction) then FOnProcessingInstruction(sender,locator,targ,data); if data = '' then result:= writeWideStrings(sender,locator,['']) else result:= writeWideStrings(sender,locator,['']); if result then if assigned(nextHandler) then result:= nextHandler.processingInstruction(sender,locator,targ,data); end; function TXmlStreamBuilder.skippedEntity(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; begin if assigned(FOnSkippedEntity) then FOnSkippedEntity(sender,locator,aname); if assigned(nextHandler) then result:= nextHandler.skippedEntity(sender,locator,aname) else result:= true; end; function TXmlStreamBuilder.startDocument(const sender: TXmlCustomReader; const locator: TdomLocator; version, encName: wideString; sdDl: TdomStandalone): boolean; const BOM: wideString = #$feff; // UTF-16BE Byte order mark var newEncodingType: TdomEncodingType; begin if assigned(FOnStartDocument) then FOnStartDocument(sender,locator,version,encName,sdDl); result:= true; if defaultEncoding = '' then begin newEncodingType:= StrToEncoding(encName); end else begin encName:= defaultEncoding; newEncodingType:= defaultEncodingType; end; case newEncodingType of etLatin1,etUTF8,etUTF16BE: begin FCurrentEncodingType:= newEncodingType; if CurrentEncodingType = etUTF16BE then result:= writeWideString(sender,locator,BOM); if result and (version = '') then result:= writeWideString(sender,locator,' '') then result:= writeWideStrings(sender,locator,[' encoding="',encName,'"']); if result then case sdDl of STANDALONE_YES: result:= writeWideStrings(sender,locator,[' standalone="yes"']); STANDALONE_NO: result:= writeWideStrings(sender,locator,[' standalone="no"']); end; if result then writeWideStrings(sender,locator,['?','>',#10]); end; else sendErrorNotification(sender,ET_ENCODING_NOT_SUPPORTED,locator,encName); result:= false; end; if result then if assigned(nextHandler) then result:= nextHandler.startDocument(sender,locator,version,encName,sdDl); end; function TXmlStreamBuilder.startElement(const sender: TXmlCustomReader; const locator: TdomLocator; namespaceURI, tagName: wideString; attributes: TdomNameValueList): boolean; var i: integer; begin if assigned(FOnStartElement) then FOnStartElement(sender,locator,namespaceURI,tagName,attributes); result:= writeWideStrings(sender,locator,['<', tagName]); for i:= 0 to pred(attributes.length) do begin if not result then break; result:= writeWideStrings(sender,locator,[' ',attributes.names[i],'="',attributes.values[i],'"']); end; if result then result:= writeWideString(sender,locator,'>'); if result then if assigned(nextHandler) then result:= nextHandler.startElement(sender,locator,namespaceURI,tagName,attributes); end; function TXmlStreamBuilder.startPrefixMapping(const sender: TXmlCustomReader; const locator: TdomLocator; prefix, uri: wideString): boolean; begin if assigned(FOnStartPrefixMapping) then FOnStartPrefixMapping(sender,locator,prefix,uri); if assigned(nextHandler) then result:= nextHandler.startPrefixMapping(sender,locator,prefix,uri) else result:= true; end; function TXmlStreamBuilder.attributeDefinition(const sender: TXmlCustomReader; const locator: TdomLocator; aname, attType, bracket, defaultDecl, attValue: wideString): boolean; const SQ: WideChar = #39; // code of ' DQ: WideChar = #34; // code of " begin if assigned(FOnAttributeDefinition) then FOnAttributeDefinition(sender,locator,aname,attType,bracket,defaultDecl,attValue); result:= writeWideStrings(sender, locator, [' ', aname, #9]); if result and (Length(attType) > 0) then result:= writeWideStrings(sender, locator, [attType, #9]); if result and (Length(bracket) > 0) then result:= writeWideString(sender, locator, bracket); if result and (Length(defaultDecl) > 0) then result:= writeWideStrings(sender, locator, [#9, defaultDecl]); if result and ((Length(defaultDecl) = 0) or (defaultDecl = wideString('#FIXED'))) then begin if Pos(DQ, attValue) > 0 then result:= writeWideStrings(sender, locator, [#9, SQ, attValue, SQ, #10]) else result:= writeWideStrings(sender, locator, [#9, DQ, attValue, DQ, #10]); end; if result then if assigned(nextHandler) then result:= nextHandler.attributeDefinition(sender,locator,aname,attType,bracket,defaultDecl,attValue); end; function TXmlStreamBuilder.conditionalSection(const sender: TXmlCustomReader; const locator: TdomLocator; includeStmt, data: wideString): boolean; begin if assigned(FOnConditionalSection) then FOnConditionalSection(sender,locator,includeStmt,data); result:= writeWideStrings(sender,locator,['']); if result then if assigned(nextHandler) then result:= nextHandler.conditionalSection(sender,locator,includeStmt,data); end; function TXmlStreamBuilder.DTDcomment(const sender: TXmlCustomReader; const locator: TdomLocator; data: wideString): boolean; begin if assigned(FOnDtdComment) then FOnDtdComment(sender,locator,data); result:= writeWideStrings(sender,locator,[#10'']); if result then if assigned(nextHandler) then result:= nextHandler.DTDcomment(sender,locator,data); end; function TXmlStreamBuilder.DTDprocessingInstruction(const sender: TXmlCustomReader; const locator: TdomLocator; targ, data : wideString): boolean; begin if assigned(FOnDtdProcessingInstruction) then FOnDtdProcessingInstruction(sender,locator,targ,data); if data = '' then result:= writeWideStrings(sender,locator,[#10'']) else result:= writeWideStrings(sender,locator,[#10'']); if result then if assigned(nextHandler) then result:= nextHandler.DTDprocessingInstruction(sender,locator,targ,data); end; function TXmlStreamBuilder.elementTypeDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, data: wideString): boolean; begin if assigned(FOnElementTypeDeclaration) then FOnElementTypeDeclaration(sender,locator,aname,data); result:= writeWideStrings(sender, locator, [#10'']); if result then if assigned(nextHandler) then result:= nextHandler.elementTypeDeclaration(sender,locator,aname,data); end; function TXmlStreamBuilder.endAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnEndAttListDeclaration) then FOnEndAttListDeclaration(sender,locator); result:= writeWideString(sender,locator,'>'); if result then if assigned(nextHandler) then result:= nextHandler.endAttListDeclaration(sender,locator); end; function TXmlStreamBuilder.endExtDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnEndExtDtd) then FOnEndExtDtd(sender,locator); FCurrentEncodingType:= etUnknown; if assigned(nextHandler) then result:= nextHandler.endExtDtd(sender,locator) else result:= true; end; function TXmlStreamBuilder.endIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnendIntDtd) then FOnendIntDtd(sender,locator); FCurrentEncodingType:= etUnknown; if assigned(nextHandler) then result:= nextHandler.endIntDtd(sender,locator) else result:= true; end; function TXmlStreamBuilder.entityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId, notaName: wideString): boolean; const SQ: WideChar = #39; // code of ' DQ: WideChar = #34; // code of " begin if assigned(FOnEntityDeclaration) then FOnEntityDeclaration(sender,locator,aname,entityValue,pubId,sysId,notaName); result:= writeWideStrings(sender, locator, [#10' 0 then result:= writeWideStrings(sender, locator, [SQ, entityValue, SQ]) else result:= writeWideStrings(sender, locator, [DQ, entityValue, DQ]); end else begin if pubId = '' then begin if Pos(DQ, sysId) > 0 then result:= writeWideStrings(sender, locator, ['SYSTEM ', SQ, sysId, SQ]) else result:= writeWideStrings(sender, locator, ['SYSTEM ', DQ, sysId, DQ]); end else begin if sysId = '' then begin result:= writeWideStrings(sender, locator, [' PUBLIC "',pubId,'"']); end else begin if Pos(DQ, sysId) > 0 then result:= writeWideStrings(sender, locator, ['PUBLIC "', pubId, '" ', SQ, sysId, SQ]) else result:= writeWideStrings(sender, locator, ['PUBLIC "', pubId, '" "', sysId, '"']); end; end; {if ...} if result and (notaName <> '') then result:= writeWideStrings(sender, locator, [' NDATA ',notaName]); end; end; if result then result:= writeWideString(sender, locator, '>'); if result then if assigned(nextHandler) then result:= nextHandler.entityDeclaration(sender,locator,aname,entityValue,pubId,sysId,notaName); end; function TXmlStreamBuilder.notationDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, pubId, sysId: wideString): boolean; const SQ: WideChar = #39; // code of ' DQ: WideChar = #34; // code of " begin if assigned(FOnNotationDeclaration) then FOnNotationDeclaration(sender,locator,aname,pubId,sysId); result:= writeWideStrings(sender, locator, [#10' 0 then result:= writeWideStrings(sender, locator, ['SYSTEM ', SQ, sysId, SQ]) else result:= writeWideStrings(sender, locator, ['SYSTEM ', DQ, sysId, DQ]); end else begin if sysId = '' then begin result:= writeWideStrings(sender, locator, [' PUBLIC "',pubId,'"']); end else begin if Pos(DQ, sysId) > 0 then result:= writeWideStrings(sender, locator, ['PUBLIC "', pubId, '" ', SQ, sysId, SQ]) else result:= writeWideStrings(sender, locator, ['PUBLIC "', pubId, '" "', sysId, '"']); end; end; {if ...} end; if result then result:= writeWideString(sender, locator, '>'); if result then if assigned(nextHandler) then result:= nextHandler.notationDeclaration(sender,locator,aname,pubId,sysId); end; function TXmlStreamBuilder.parameterEntityDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname, entityValue, pubId, sysId: wideString): boolean; const SQ: WideChar = #39; // code of ' DQ: WideChar = #34; // code of " begin if assigned(FOnParameterEntityDeclaration) then FOnParameterEntityDeclaration(sender,locator,aname,entityValue,pubId,sysId); result:= writeWideStrings(sender, locator, [#10' 0 then result:= writeWideStrings(sender, locator, [SQ, entityValue, SQ]) else result:= writeWideStrings(sender, locator, [DQ, entityValue, DQ]); end else begin if pubId = '' then begin if Pos(DQ, sysId) > 0 then result:= writeWideStrings(sender, locator, ['SYSTEM ', SQ, sysId, SQ]) else result:= writeWideStrings(sender, locator, ['SYSTEM ', DQ, sysId, DQ]); end else begin if sysId = '' then begin result:= writeWideStrings(sender, locator, [' PUBLIC "',pubId,'"']); end else begin if Pos(DQ, sysId) > 0 then result:= writeWideStrings(sender, locator, ['PUBLIC "', pubId, '" ', SQ, sysId, SQ]) else result:= writeWideStrings(sender, locator, ['PUBLIC "', pubId, '" "', sysId, '"']); end; end; {if ...} end; end; if result then result:= writeWideString(sender, locator, '>'); if result then if assigned(nextHandler) then result:= nextHandler.parameterEntityDeclaration(sender,locator,aname,entityValue,pubId,sysId); end; function TXmlStreamBuilder.parameterEntityRef(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; begin if assigned(FOnParameterEntityRef) then FOnParameterEntityRef(sender,locator,aname); result:= writeWideStrings(sender, locator, [#10'%',aname,';']); if result then if assigned(nextHandler) then result:= nextHandler.parameterEntityRef(sender,locator,aname); end; function TXmlStreamBuilder.startAttListDeclaration(const sender: TXmlCustomReader; const locator: TdomLocator; aname: wideString): boolean; begin if assigned(FOnStartAttListDeclaration) then FOnStartAttListDeclaration(sender,locator,aname); result:= writeWideStrings(sender,locator,[#10' '') then result:= writeWideStrings(sender,locator,[' encoding="',encName,'"']); if result then writeWideString(sender,locator,'?>'); end; else sendErrorNotification(sender,ET_ENCODING_NOT_SUPPORTED,locator,encName); result:= false; end; if result then if assigned(nextHandler) then result:= nextHandler.startExtDtd(sender,locator,version,encName); end; function TXmlStreamBuilder.startIntDtd(const sender: TXmlCustomReader; const locator: TdomLocator): boolean; begin if assigned(FOnstartIntDtd) then FOnstartIntDtd(sender,locator); FCurrentEncodingType:= defaultEncodingType; if assigned(nextHandler) then result:= nextHandler.startIntDtd(sender,locator) else result:= true; end; function TXmlStreamBuilder.resolvePE( PEReferenceName: wideString; var PEValue: wideString; var error: TXmlErrorType): boolean; begin if assigned(nextHandler) then result:= nextHandler.resolvePE(PEReferenceName,PEValue,error) else begin PEValue:= ''; error:= ET_UNRESOLVABLE_PARAMETER_ENTITY_REFERENCE; result:= true; end; end; procedure TXmlStreamBuilder.notifyReset; begin FCurrentEncodingType:= etUnknown; if assigned(nextHandler) then nextHandler.notifyReset; end; // ++++++++++++++++++++++ TXmlStandardDocReader ++++++++++++++++++++++++ constructor TXmlStandardDocReader.create(AOwner: TComponent); begin inherited create(AOwner); suppressXmlns:= false; prefixMapping:= true; FPrefixMappingStack:= TList.Create; end; destructor TXmlStandardDocReader.destroy; begin clearPrefixMappingStack; FPrefixMappingStack.free; inherited destroy; end; function TXmlStandardDocReader.analyzeElement(const locator: TdomLocator; const source: wideString; out tagName: wideString; const attributes: TdomNameValueList): boolean; // 'Source': The element, to be analyzed. // 'tagName': Returns the namen of the element. // 'attributes': Returns a list of attributes, if existing. const NULL: WideChar = #0; // end of wideString mark TAB: WideChar = #9; LF: WideChar = #10; CR: WideChar = #13; SPACE: WideChar = #32; SQ: WideChar = #39; // code of ' DQ: WideChar = #34; // code of " EQ: WideChar = #61; // code of = var head,tail: PWideChar; attrName,attrValue: wideString; quotationMark: WideChar; begin result:= true; attributes.clear; head:= PWideChar(source); tail:= head; while not IsXmlWhiteSpace(tail^) and (tail^ <> NULL) do inc(tail); setString(tagName,head,tail-head); head:= tail; while head^ <> NULL do begin while IsXmlWhiteSpace(head^) and (head^ <> NULL) do inc(head); if head^ <> NULL then begin tail:= head; while not IsXmlWhiteSpace(tail^) and not (tail^ in [NULL,EQ]) do inc(tail); setString(attrName,head,tail-head); head:= tail; while IsXmlWhiteSpace(head^) and (head^ <> NULL) do inc(head); if head^ <> EQ then begin result:= sendErrorNotification(ET_MISSING_EQUALITY_SIGN,locator,''); exit; end; inc(head); while IsXmlWhiteSpace(head^) and (head^ <> NULL) do inc(head); if not (head^ in [SQ,DQ]) then begin result:= sendErrorNotification(ET_MISSING_QUOTATION_MARK,locator,''); exit; end; quotationMark:= WideChar(head^); inc(head); tail:= head; while not (tail^ in [NULL,quotationMark]) do inc(tail); if tail^ = NULL then begin result:= sendErrorNotification(ET_MISSING_QUOTATION_MARK,locator,''); exit; end; setString(attrValue,head,tail-head); if attributes.indexOfName(attrName) > -1 then begin result:= sendErrorNotification(ET_DOUBLE_ATTRIBUTE_NAME,locator,''); exit; end; attributes.add(attrName,attrValue); head:= tail; inc(head); if not IsXmlWhiteSpace(head^) and (head^ <> NULL) then begin result:= sendErrorNotification(ET_MISSING_WHITE_SPACE,locator,''); exit; end; end; {if ...} end; {while ...} end; procedure TXmlStandardDocReader.clearPrefixMappingStack; begin with FPrefixMappingStack do begin while count > 0 do begin TdomNameValueList(last).free; delete(pred(count)); end; end; end; function TXmlStandardDocReader.writeProcessingInstruction(const locator: TdomLocator; const content: wideString): boolean; var TargetName,AttribSequence: wideString; begin XMLAnalyseTag(content,TargetName,AttribSequence); if assigned(NextHandler) then result:= NextHandler.ProcessingInstruction(self,locator,TargetName,AttribSequence) else result:= true; end; function TXmlStandardDocReader.writeComment(const locator: TdomLocator; const content: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.comment(self,locator,content) else result:= true; end; function TXmlStandardDocReader.writeCDATA(const locator: TdomLocator; const content: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.cdata(self,locator,content) else result:= true; end; function TXmlStandardDocReader.writeCharRef(const locator: TdomLocator; const content: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.charRef(self,locator,content) else result:= true; end; function TXmlStandardDocReader.writePCDATA(const locator: TdomLocator; const content: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.pcdata(self,locator,content) else result:= true; end; function TXmlStandardDocReader.writeStartDocument(const locator: TdomLocator; version, encName: wideString; sdDl: TdomStandalone): boolean; begin clearPrefixMappingStack; if assigned(NextHandler) then result:= NextHandler.startDocument(self,locator,version,encName,sdDl) else result:= true; end; function TXmlStandardDocReader.writeStartElement(const locator: TdomLocator; const content: wideString; out tagName: wideString): boolean; var attrList: TdomNameValueList; attributeList: TdomNameValueList; pfxUriList: TdomNameValueList; i: integer; suppressThisAttr: boolean; begin attrList:= TdomNameValueList.create; try result:= analyzeElement(locator,content,tagName,attrList); if result then begin if assigned(NextHandler) then begin attributeList:= TdomNameValueList.create; try pfxUriList:= TdomNameValueList.create; FPrefixMappingStack.Add(pfxUriList); with attrList do begin for i:= 0 to pred(length) do begin suppressThisAttr:= false; if FPrefixMapping or FSuppressXmlns then begin if IsXmlDefaultAttName(names[i]) then begin suppressThisAttr:= FSuppressXmlns; pfxUriList.add('',values[i]); end else if IsXmlPrefixedAttName(names[i]) then begin suppressThisAttr:= FSuppressXmlns; pfxUriList.add(xmlExtractLocalName(names[i]),values[i]); end; end; if not suppressThisAttr then attributeList.add(names[i],values[i]); end; {for ...} end; {with ...} if FPrefixMapping then with pfxUriList do for i:= 0 to pred(length) do begin result:= writeStartPrefixMapping(locator,names[i],values[i]); if not result then break; end; result:= NextHandler.startElement(self,locator,'',tagName,attributeList) finally attributeList.free; end; end else result:= true; end; finally attrList.free; end; end; function TXmlStandardDocReader.writeStartPrefixMapping(const locator: TdomLocator; prefix, uri: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.startPrefixMapping(self,locator,prefix,uri) else result:= true; end; function TXmlStandardDocReader.writeEndDocument(const locator: TdomLocator): boolean; begin if assigned(NextHandler) then result:= NextHandler.endDocument(self,locator) else result:= true; end; function TXmlStandardDocReader.writeEndElement(const locator: TdomLocator; const content: wideString): boolean; var pfxUriList: TdomNameValueList; i: integer; begin if assigned(NextHandler) then result:= NextHandler.endElement(self,locator,'',content) else result:= true; with FPrefixMappingStack do begin if count > 0 then begin pfxUriList:= last; delete(pred(count)); try if FPrefixMapping then with pfxUriList do for i:= pred(length) downto 0 do begin if not result then break; result:= writeEndPrefixMapping(locator,names[i]); end; finally pfxUriList.free; end; end; end; end; function TXmlStandardDocReader.writeEndPrefixMapping(const locator: TdomLocator; prefix: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.endPrefixMapping(self,locator,prefix) else result:= true; end; function TXmlStandardDocReader.writeEmptyElement(const locator: TdomLocator; const content: wideString): boolean; var tagName: wideString; begin result:= writeStartElement(locator,content,tagName); if result then result:= writeEndElement(locator,tagName); end; function TXmlStandardDocReader.writeEntityRef(const locator: TdomLocator; const content: wideString): boolean; var EntityName: wideString; begin EntityName:= copy(content,2,length(content)-2); if (EntityName='lt') then begin Result:= writeCharRef(locator, '<'); Exit; end else if (EntityName='gt') then begin Result:= writeCharRef(locator, '>'); Exit; end else if (EntityName='amp') then begin Result:= writeCharRef(locator, '&'); Exit; end else if (EntityName='apos') then begin Result:= writeCharRef(locator, '''); Exit; end else if (EntityName='quot') then begin Result:= writeCharRef(locator, '"'); Exit; end; if assigned(NextHandler) then result:= NextHandler.EntityRef(self,locator,EntityName) else result:= true; end; function TXmlStandardDocReader.writeDoctype(const locator: TdomLocator; const content: wideString): boolean; var DeclAnfg: integer; ExternalId,intro,name,SystemLiteral,PubidLiteral: wideString; NakedContent,data,dummy1,dummy2: wideString; Error: boolean; begin result:= true; if (copy(content,1,9) <> ' '>') or (not IsXmlWhiteSpace(content[10])) then begin result:= sendErrorNotification(ET_INVALID_DOCTYPE,locator,''); end else begin NakedContent:= XmlTrunc(copy(content,11,length(content)-11)); DeclAnfg:= Pos(wideString('['),NakedContent); if DeclAnfg = 0 then begin intro:= NakedContent; Data:= ''; end else begin intro:= copy(NakedContent,1,DeclAnfg-1); dummy1:= copy(NakedContent,DeclAnfg,length(NakedContent)-DeclAnfg+1); XMLTruncAngularBrackets(dummy1,data,error); {Diese umständliche Zuweisung ist wegen Delphi-Problem von WideStrings bei copy nötig} if error then begin result:= sendErrorNotification(ET_INVALID_DOCTYPE,locator,''); end; {if ...} end; {if ...} if result then begin XMLAnalyseTag(intro,name,ExternalId); if not IsXmlName(name) then begin result:= sendErrorNotification(ET_INVALID_DOCTYPE,locator,''); end else begin dummy1:= XmlTrunc(ExternalId); ExternalId:= dummy1; {Diese umständliche Zuweisung ist wegen der Verwendung von WideStrings nötig} if ExternalId <> '' then begin XMLAnalyseEntityDef(ExternalId,dummy1,SystemLiteral,PubidLiteral,dummy2,Error); if Error or (dummy1 <> '') or (dummy2 <> '') then begin result:= sendErrorNotification(ET_INVALID_DOCTYPE,locator,''); end; {if ...} end; if result then if assigned(NextHandler) then result:= NextHandler.doctype(self,locator,name,PubidLiteral,SystemLiteral,Data); end; {if ... else ...} end; {if ...} end; {if ... else ...} end; function TXmlStandardDocReader.parse(const inputSource: TXmlInputSource): boolean; const CR: WideChar = #13; LF: WideChar = #10; QM: WideChar = '?'; ampCode: word = 38; // code of & gtCode: word = 60; // code of < SingleQuote: WideChar = #39; // code of ' DoubleQuote: WideChar = #34; // code of " NUMBERSIGN: WideChar = #35; // code of # SOLIDUS: WideChar = #47; // code of / PISTART: wideString = ''; COMMENTSTART: wideString = ''; end else if SubStartMarker <> '' then begin SubStartMarker:= ''; end; if (str1 = ']') and (not SingleQuoteOpen) and (not DoubleQuoteOpen) then BracketOpened:= false; end; {if not ...} end else begin {if BracketOpened ... } if (str1 = '[') and (not SingleQuoteOpen) and (not DoubleQuoteOpen) then BracketOpened:= true; end; {if BracketOpened ... else ...} end else begin; {if (SubEndMarker = '') ...} if content.endsWith(SubEndMarker) then SubEndMarker:= ''; end; {if (SubEndMarker = '') ... else ...} if (not DoubleQuoteOpen) and (not SingleQuoteOpen) and (not BracketOpened) and (SubEndMarker = '') and (str1 = '>') then begin result:= writeDoctype(inputSource.Locator,content.value); content.reset; PieceType:= xmlUnknown; end; end; {xmlDoctype: ...} xmlUnknown: begin if str1 = '<' then PieceType:= xmlStartTag else if str1 = '&' then PieceType:= xmlEntityRef else PieceType:= xmlPCData; content.AddWideChar(Str1); inputsource.locator.setStartMark; end; end; {case ...} end; {while ...} if result then if content.length > 0 then if PieceType= xmlPCData then result:= writePCDATA(inputSource.Locator,content.value) else result:= sendErrorNotification(ET_INVALID_CHARACTER,inputSource.locator,content.value); if result then result:= writeEndDocument(inputSource.Locator); finally clearPrefixMappingStack; content.free; end; {try} end; // +++++++++++++++++++++ TXmlStandardDtdReader +++++++++++++++++++++ function TXmlStandardDtdReader.findNextAttDef(const decl: wideString; var aname, attType, bracket, defaultDecl, attValue, rest: wideString): boolean; // Return value: 'false' if a wellformedness error occured; 'true' otherwise. var i,j: integer; FindBracket, FindDefaultDecl, FindAttValue: boolean; QuoteType: WideChar; begin result:= true; attType:= ''; attValue:= ''; bracket:= ''; findAttValue:= false; findBracket:= false; findDefaultDecl:= false; defaultDecl:= ''; aname:= ''; rest:= ''; if Length(Decl) = 0 then begin result:= false; exit; end; i:= 1; {White-space?} while IsXmlWhiteSpace(Decl[i]) do begin inc(i); if i > length(Decl) then begin result:= false; exit; end; end; j:= i; {name?} while not IsXmlWhiteSpace(Decl[i]) do begin inc(i); if i > length(Decl) then begin result:= false; exit; end; end; aname:= copy(Decl,j,i-j); {White-space?} while IsXmlWhiteSpace(Decl[i]) do begin inc(i); if i > length(Decl) then begin result:= false; exit; end; end; j:= i; if Decl[j] = '(' then FindBracket:= true; {attType?} if not FindBracket then begin while not IsXmlWhiteSpace(Decl[i]) do begin inc(i); if i > length(Decl) then begin result:= false; exit; end; end; attType:= copy(Decl,j,i-j); if attType = 'NOTATION' then FindBracket:= true; {White-space?} while IsXmlWhiteSpace(Decl[i]) do begin inc(i); if i > length(Decl) then begin result:= false; exit; end; end; j:= i; end; {if ...} {Bracket?} if FindBracket then begin if Decl[j] <> '(' then begin result:= false; exit; end; while not (Decl[i] = ')') do begin inc(i); if i >= length(Decl) then begin result:= false; exit; end; end; Bracket:= copy(Decl,j,i-j+1); {White-space?} inc(i); if not IsXmlWhiteSpace(Decl[i]) then begin result:= false; exit; end; while IsXmlWhiteSpace(Decl[i]) do begin inc(i); if i > length(Decl) then begin result:= false; exit; end; end; j:= i; end; {if ...} if Decl[j] = '#' then FindDefaultDecl:= true else FindAttValue:= true; {defaultDecl?} if FindDefaultDecl then begin while not IsXmlWhiteSpace(Decl[i]) do begin inc(i); if i > length(Decl) then break; end; {while ...} defaultDecl:= copy(Decl,j,i-j); if defaultDecl = '#FIXED' then begin FindAttValue:= true; {White-space?} if i > length(Decl) then begin result:= false; exit; end; while IsXmlWhiteSpace(Decl[i]) do begin inc(i); if i > length(Decl) then begin result:= false; exit; end; end; {while ...} j:= i; end; {if ...} end; {if ...} {attValue?} if FindAttValue then begin if i = length(Decl) then begin result:= false; exit; end; QuoteType:= Decl[i]; if not ( (QuoteType = '"') or (QuoteType = #$0027)) then begin result:= false; exit; end; inc(i); while not (Decl[i] = QuoteType) do begin inc(i); if i > length(Decl) then begin result:= false; exit; end; end; {while ...} attValue:= copy(Decl,j+1,i-j-1); inc(i); end; {if ...} Rest:= copy(Decl,i,length(Decl)-i+1); end; function TXmlStandardDtdReader.includeAsPE(const inputSource: TXmlInputSource; var s: wideString): boolean; begin result:= includeInLiteral(inputSource,s); s:= concat(#$20,s,#$20); end; function TXmlStandardDtdReader.includeInLiteral(const inputSource: TXmlInputSource; var s: wideString): boolean; var str1: WideChar; PEName: TdomCustomStr; errType: TXmlErrorType; invalidStr: wideString; begin s:= ''; result:= true; PEName:= TdomCustomStr.create; try while InputSource.getNextWideChar(str1) do begin if not IsXmlChar(str1) then begin inputsource.locator.setStartMark; if str1 = #0 then invalidStr:= '' else invalidStr:= wideString(str1); result:= sendErrorNotification(ET_INVALID_CHARACTER,inputSource.locator,invalidStr); exit; end; if str1 = ';' then begin // End of PE reference found. errType:= ET_UNRESOLVABLE_PARAMETER_ENTITY_REFERENCE; if assigned(NextHandler) then result:= NextHandler.resolvePE(PEName.value,s,errType); if errType <> ET_NONE then begin s:= concat('%',PEName.value,';'); result:= (sendErrorNotification(errType,inputSource.locator,PEName.value) and result); end; exit; end; PEName.addWideChar(str1); if ( (PEName.length = 1) and not ( IsXmlLetter(str1) or (str1 = '_') or (str1 = ':') ) ) or ( (PEName.length > 1) and not IsXmlNameChar(str1) ) then break; end; {while ...} s:= concat('%',PEName.value); finally PEName.free; end; end; function TXmlStandardDtdReader.WriteConditionalSection(const locator: TdomLocator; const content: wideString): boolean; var declaration: wideString; IncludeStmt: wideString; i,nr1,nr2: longint; begin nr1:= 0; nr2:= 0; for i:= 1 to length(content) do begin if content[i] = '[' then begin if nr1 = 0 then nr1:= i else nr2:= i; end; if nr2 > 0 then break; end; if nr2 = 0 then begin result:= sendErrorNotification(ET_INVALID_CONDITIONAL_SECTION,locator,''); exit; end; if (copy(content,1,3) <> ' ']]>') then begin result:= sendErrorNotification(ET_INVALID_CONDITIONAL_SECTION,locator,''); exit; end; IncludeStmt:= XmlTrunc(copy(content,4,nr2-4)); if not ( IsXmlPEReference(IncludeStmt) or (IncludeStmt = 'INCLUDE') or (IncludeStmt = 'IGNORE') ) then begin result:= sendErrorNotification(ET_INVALID_CONDITIONAL_SECTION,locator,''); exit; end; declaration:= XmlTrunc(copy(content,nr2+1,length(content)-nr2-3)); if assigned(NextHandler) then result:= NextHandler.conditionalSection(self,locator,IncludeStmt,declaration) else result:= true; end; function TXmlStandardDtdReader.WriteDTDProcessingInstruction(const locator: TdomLocator; const content: wideString): boolean; var TargetName,AttribSequence: wideString; begin XMLAnalyseTag(content,TargetName,AttribSequence); if assigned(NextHandler) then result:= NextHandler.DTDProcessingInstruction(self,locator,TargetName,AttribSequence) else result:= true; end; function TXmlStandardDtdReader.WriteDTDComment(const locator: TdomLocator; const content: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.DTDcomment(self,locator,content) else result:= true; end; function TXmlStandardDtdReader.WriteParameterEntityRef(const locator: TdomLocator; const content: wideString): boolean; var entityName: wideString; begin entityName:= copy(content,2,length(content)-2); if assigned(NextHandler) then result:= NextHandler.parameterEntityRef(self,locator,entityName) else result:= true; end; function TXmlStandardDtdReader.WriteEntityDeclaration(const locator: TdomLocator; const content: wideString): boolean; var DeclCorpus,DeclName,EntityDef,entityValue,SystemLiteral,PubidLiteral,NDataName: wideString; DeclTypus: TDomCMNodeType; dummy: wideString; Error: boolean; begin result:= true; if (copy(content,1,8) <> ' '>') or (length(content) < 14) or (not IsXmlWhiteSpace(content[9])) then begin result:= sendErrorNotification(ET_INVALID_ENTITY_DECL,locator,''); exit; end; DeclCorpus:= XMLTrunc(copy(content,10,length(content)-10)); if DeclCorpus[1] = '%' then begin if not IsXmlWhiteSpace(DeclCorpus[2]) then begin result:= sendErrorNotification(ET_INVALID_ENTITY_DECL,locator,''); exit; end; dummy:= XMLTrunc(copy(DeclCorpus,2,length(DeclCorpus)-1)); DeclCorpus:= dummy; DeclTypus:= ctParameterEntityDeclaration; end else DeclTypus:= ctEntityDeclaration; XMLAnalyseTag(DeclCorpus,DeclName,EntityDef); XMLAnalyseEntityDef(EntityDef,entityValue,SystemLiteral,PubidLiteral,NDataName,Error); if Error then begin result:= sendErrorNotification(ET_INVALID_ENTITY_DECL,locator,''); exit; end; if (DeclTypus = ctParameterEntityDeclaration) and (NDataName <> '') then begin result:= sendErrorNotification(ET_INVALID_ENTITY_DECL,locator,''); exit; end; if result then if assigned(NextHandler) then begin case DeclTypus of ctEntityDeclaration: NextHandler.entityDeclaration(self,locator,DeclName,entityValue,PubidLiteral,SystemLiteral,NDataName); ctParameterEntityDeclaration: NextHandler.parameterentityDeclaration(self,locator,DeclName,entityValue,PubidLiteral,SystemLiteral); end; {case ...} end; {if ...} end; function TXmlStandardDtdReader.WriteElementDeclaration(const locator: TdomLocator; const content: wideString): boolean; var DeclCorpus,DeclName,contSpec: wideString; begin if length(content) < 16 then begin result:= sendErrorNotification(ET_INVALID_ELEMENT_DECL,locator,''); exit; end; if (copy(content,1,9) <> ' '>') or (not IsXmlWhiteSpace(content[10])) then begin result:= sendErrorNotification(ET_INVALID_ELEMENT_DECL,locator,''); exit; end; DeclCorpus:= XMLTrunc(copy(content,11,length(content)-11)); XMLAnalyseTag(DeclCorpus,DeclName,contSpec); if assigned(NextHandler) then result:= NextHandler.elementTypeDeclaration(self,locator,DeclName,contSpec) else result:= true; end; function TXmlStandardDtdReader.WriteAttributeDeclaration(const locator: TdomLocator; const content: wideString): boolean; var declCorpus,declName,contSpec: wideString; dummy,AttDefName,attType,Bracket,defaultDecl,attValue,Rest: wideString; ok: boolean; begin result:= true; if length(Content) < 12 then begin result:= sendErrorNotification(ET_INVALID_ATTRIBUTE_DECL,locator,content); exit; end; if (copy(Content,1,9) <> ' '>') or (not IsXmlWhiteSpace(Content[10])) then begin result:= sendErrorNotification(ET_INVALID_ATTRIBUTE_DECL,locator,content); exit; end; DeclCorpus:= XMLTrunc(copy(Content,11,length(Content)-11)); XMLAnalyseTag(DeclCorpus,DeclName,contSpec); if assigned(NextHandler) then begin result:= NextHandler.startAttListDeclaration(self,locator,DeclName); end; if result then begin dummy:= XMLTrunc(contSpec); contSpec:= dummy; while contSpec <> '' do begin ok:= findNextAttDef(contSpec,AttDefName,attType,Bracket, defaultDecl,attValue,Rest); if ok then begin if assigned(NextHandler) then begin result:= NextHandler.attributeDefinition(self,locator,attDefName,attType,bracket, defaultDecl,attValue); if not result then break; end; end else begin result:= sendErrorNotification(ET_INVALID_ATTRIBUTE_DECL,locator,content); break; end; contSpec:= Rest; end; {while ...} end; {if ...} if result then if assigned(NextHandler) then result:= NextHandler.endAttListDeclaration(self,locator); end; function TXmlStandardDtdReader.WriteNotationDeclaration(const locator: TdomLocator; const content: wideString): boolean; var DeclCorpus,DeclName,contSpec,SystemLiteral,PubidLiteral: wideString; Error: boolean; begin if length(Content) < 22 then begin result:= sendErrorNotification(ET_INVALID_NOTATION_DECL,locator,''); exit; end; if (copy(Content,1,10) <> ' '>') or (not IsXmlWhiteSpace(Content[11])) then begin result:= sendErrorNotification(ET_INVALID_NOTATION_DECL,locator,''); exit; end; DeclCorpus:= XMLTrunc(copy(Content,12,length(Content)-12)); XMLAnalyseTag(DeclCorpus,DeclName,contSpec); XMLAnalyseNotationDecl(contSpec,SystemLiteral,PubidLiteral,Error); if Error then begin result:= sendErrorNotification(ET_INVALID_NOTATION_DECL,locator,''); exit; end; if assigned(NextHandler) then result:= NextHandler.notationDeclaration(self,locator,DeclName,PubidLiteral,SystemLiteral) else result:= true; end; function TXmlStandardDtdReader.writeStartExtDtd(const locator: TdomLocator; version, encName: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.startExtDtd(self,locator,version,encName) else result:= true; end; function TXmlStandardDtdReader.writeStartIntDtd(const locator: TdomLocator): boolean; begin if assigned(NextHandler) then result:= NextHandler.startIntDtd(self,locator) else result:= true; end; function TXmlStandardDtdReader.parseExternalSubset(const inputSource: TXmlInputSource):boolean; const CR: WideChar = #13; LF: WideChar = #10; QM: WideChar = '?'; SingleQuote: WideChar = #39; // code of ' DoubleQuote: WideChar = #34; // code of " PISTART: wideString = '' then if content[content.length-1] = QM then begin if result then begin result:= writeDTDProcessingInstruction(inputSource.Locator,copy(content.value,3,content.length-4)); content.reset; PieceType:= xmlUnknown; end; end; end; xmlCondSection: begin if includeStatementFinished then begin content.addWideChar(str1); if str1 = '[' then begin if content[content.length-1] = '!' then if content[content.length-2] = '<' then if not commentActive then inc(condSectCounter); end else if str1 = '>' then begin if content[content.length-1] = ']' then if content[content.length-2] = ']' then if not commentActive then dec(condSectCounter); end; {if str1 = '[' ... else ...} if commentActive then begin if str1 = '>' then if content[content.length-1] = '-' then if content[content.length-2] = '-' then if not ( (content[content.length-3] = '!') and (content[content.length-4] = '<') ) then if not ( (content[content.length-3] = '-') and (content[content.length-4] = '!') and (content[content.length-5] = '<') ) then commentActive:= false; end else begin if str1 = '-' then if content[content.length-1] = '-' then if content[content.length-2] = '!' then if content[content.length-3] = '<' then commentActive:= true; end; {if commentActive ... else ...} if condSectCounter = 0 then begin result:= WriteConditionalSection(inputSource.Locator,content.value); content.reset; PieceType:= xmlUnknown; end; {if ...} end else begin {if includeStatementFinished ... } if str1 = '[' then includeStatementFinished:= true; if str1 = '%' then begin if includeAsPE(inputSource,dummy) then begin for i:= 0 to pred(length(dummy)) do begin if dummy[i] = '[' then begin includeStatementFinished:= true; break; end; {if ...} end; {for ...} content.addWideString(dummy); end else result:= sendErrorNotification(ET_UNRESOLVABLE_PARAMETER_ENTITY_REFERENCE,inputSource.locator,concat(content.value,'%')); end else content.addWideChar(str1); end; {if includeStatementFinished ... else ...} end; xmlComment: begin content.addWideChar(str1); if str1 = '>' then if content[content.Length-1] = '-' then if content[content.Length-2] = '-' then if content.length > 6 then begin result:= WriteDTDComment(inputSource.Locator,copy(content.value,5,content.length-7)); content.reset; PieceType:= xmlUnknown; end; end; xmlEntityDecl,xmlNotationDecl: begin if not (DoubleQuoteOpen or SingleQuoteOpen) then begin if str1 = '%' then begin if includeAsPE(inputSource,dummy) then content.addWideString(dummy) else result:= sendErrorNotification(ET_UNRESOLVABLE_PARAMETER_ENTITY_REFERENCE,inputSource.locator,concat(content.value,'%')); end else content.addWideChar(str1); end else begin if (PieceType = xmlEntityDecl) and (str1 = '%') then begin // XML 1.0, § 4.4.5: "When ... a parameter entity // reference appears in a literal entity value, its // replacement text is processed in place of the // reference itself as though it were part of the // document at the location the reference was // recognized, except that ... result:= includeInLiteral(inputSource,entityDeclValue); content.addWideString( // ... a single or double quote character in the // replacement text is always treated as a normal // data character and will not terminate the literal." xmlReplaceQuotes(entityDeclValue) ); end else content.addWideChar(str1); end; if (str1 = SingleQuote) and (not DoubleQuoteOpen) then begin SingleQuoteOpen := not SingleQuoteOpen; end else if (str1 = DoubleQuote) and (not SingleQuoteOpen) then begin DoubleQuoteOpen := not DoubleQuoteOpen; end; if (not DoubleQuoteOpen) and (not SingleQuoteOpen) and (str1 = '>') then begin if pieceType = xmlEntityDecl then result:= WriteEntityDeclaration(inputSource.Locator,content.value) else result:= WriteNotationDeclaration(inputSource.Locator,content.value); content.reset; PieceType:= xmlUnknown; end; end; xmlAttributeDecl: begin if not (DoubleQuoteOpen or SingleQuoteOpen) then begin if str1 = '%' then begin if includeAsPE(inputSource,dummy) then content.addWideString(dummy) else result:= sendErrorNotification(ET_UNRESOLVABLE_PARAMETER_ENTITY_REFERENCE,inputSource.locator,concat(content.value,'%')); end else content.addWideChar(str1); end else content.addWideChar(str1); if (str1 = SingleQuote) and (not DoubleQuoteOpen) then begin SingleQuoteOpen := not SingleQuoteOpen; end else if (str1 = DoubleQuote) and (not SingleQuoteOpen) then begin DoubleQuoteOpen := not DoubleQuoteOpen; end; if str1 = '>' then begin result:= WriteAttributeDeclaration(inputSource.Locator,content.value); content.reset; PieceType:= xmlUnknown; end; end; xmlElementDecl: begin if str1 = '%' then begin if includeAsPE(inputSource,dummy) then content.addWideString(dummy) else result:= sendErrorNotification(ET_UNRESOLVABLE_PARAMETER_ENTITY_REFERENCE,inputSource.locator,concat(content.value,'%')); end else content.addWideChar(str1); if str1 = '>' then begin result:= WriteElementDeclaration(inputSource.Locator,content.value); content.reset; PieceType:= xmlUnknown; end; end; xmlUnknown: begin if str1 = '<' then begin PieceType:= xmlStartTag; content.addWideChar(str1); inputsource.locator.setStartMark; end else if str1 = '%' then begin PieceType:= xmlParameterEntityRef; content.addWideChar(str1); inputsource.locator.setStartMark; end else if not IsXmlWhiteSpace(str1) then begin result:= sendErrorNotification(ET_INVALID_CHARACTER,inputSource.locator,content.value); end; end; end; {case ...} end; {while ...} if result then begin if (content.length > 0) and not IsXmlS(content.value) then begin result:= sendErrorNotification(ET_UNKNOWN_DECL_TYPE,inputSource.locator,content.value); end; end; if result then if assigned(NextHandler) then result:= NextHandler.endExtDtd(self,inputSource.locator); finally content.free; end; end; function TXmlStandardDtdReader.parseInternalSubset(const inputSource: TXmlInputSource):boolean; const CR: WideChar = #13; LF: WideChar = #10; QM: WideChar = '?'; SingleQuote: WideChar = #39; // code of ' DoubleQuote: WideChar = #34; // code of " PISTART: wideString = '' then if content[content.Length-1] = QM then begin result:= WriteDTDProcessingInstruction(inputSource.Locator,copy(content.value,3,content.length-4)); content.reset; PieceType:= xmlUnknown; end; end; xmlComment: begin content.addWideChar(str1); if str1 = '>' then if content[content.Length-1] = '-' then if content[content.Length-2] = '-' then if content.length > 6 then begin result:= WriteDTDComment(inputSource.Locator,copy(content.value,5,content.length-7)); content.reset; PieceType:= xmlUnknown; end; end; xmlEntityDecl,xmlNotationDecl: begin content.addWideChar(str1); if (str1 = SingleQuote) and (not DoubleQuoteOpen) then begin SingleQuoteOpen := not SingleQuoteOpen; end else if (str1 = DoubleQuote) and (not SingleQuoteOpen) then begin DoubleQuoteOpen := not DoubleQuoteOpen; end; if (not DoubleQuoteOpen) and (not SingleQuoteOpen) and (str1 = '>') then begin if pieceType = xmlEntityDecl then result:= WriteEntityDeclaration(inputSource.Locator,content.value) else result:= WriteNotationDeclaration(inputSource.Locator,content.value); content.reset; PieceType:= xmlUnknown; end; end; xmlAttributeDecl: begin content.addWideChar(str1); if str1 = '>' then begin result:= WriteAttributeDeclaration(inputSource.Locator,content.value); content.reset; PieceType:= xmlUnknown; end; end; xmlElementDecl: begin content.addWideChar(str1); if str1 = '>' then begin result:= WriteElementDeclaration(inputSource.Locator,content.value); content.reset; PieceType:= xmlUnknown; end; end; xmlUnknown: begin if str1 = '<' then begin PieceType:= xmlStartTag; content.addWideChar(str1); inputsource.locator.setStartMark; end else if str1 = '%' then begin PieceType:= xmlParameterEntityRef; content.addWideChar(str1); inputsource.locator.setStartMark; end else if not IsXmlWhiteSpace(str1) then begin result:= sendErrorNotification(ET_INVALID_CHARACTER,inputSource.locator,content.value); end; end; end; {case ...} end; {while ...} if result then begin if (content.length > 0) and not IsXmlS(content.value) then begin result:= sendErrorNotification(ET_UNKNOWN_DECL_TYPE,inputSource.locator,content.value); end; end; if result then if assigned(NextHandler) then result:= NextHandler.endIntDtd(self,inputSource.locator); finally content.free; end; end; // ++++++++++++++++++++++++ TXmlCustomDomReader ++++++++++++++++++++++++ constructor TXmlCustomDomReader.create(AOwner: TComponent); begin inherited create(AOwner); suppressXmlns:= false; prefixMapping:= true; end; function TXmlCustomDomReader.parseloop(const sourceNode: TDomNode): boolean; var i: integer; attributeList: TdomNameValueList; pfxUriList: TdomNameValueList; snSystemId, versionNumber: wideString; suppressThisAttr: boolean; loc: TdomLocator; function writeWhileCheckingForAMPAndLT(const locator: TdomLocator; const source: wideString): boolean; var i: integer; content: TdomCustomStr; begin result:= true; content:= TdomCustomStr.create; try for i:= 1 to length(source) do begin case ord(source[i]) of { 60: begin // LT result:= WritePCDATA(locator,content.value); if not result then break; result:= WriteCharRef(locator,'<'); if not result then break; content.reset; end; 38: begin // AMP result:= WritePCDATA(locator,content.value); if not result then break; result:= WriteCharRef(locator,'&'); if not result then break; content.reset; end;} 60: begin // LT result:= WritePCDATA(locator,content.value); if not result then break; result:= WriteCharRef(locator,'<'); if not result then break; content.reset; end; 38: begin // AMP result:= WritePCDATA(locator,content.value); if not result then break; result:= WriteCharRef(locator,'&'); if not result then break; content.reset; end; else content.addWideChar(source[i]); end; end; if content.length > 0 then if result then result:= WritePCDATA(locator,content.value); finally content.free; end; end; begin result:= true; with sourceNode do if assigned(sourceNode.ownerDocument) then snSystemId:= sourceNode.ownerDocument.systemId else snSystemId:= ''; loc:= TdomLocator.create(-1,-1,-1,-1,-1,snSystemId,nil,sourceNode); try case sourceNode.nodeType of ntElement_Node: begin attributeList:= TdomNameValueList.create; pfxUriList:= TdomNameValueList.create; try for i:= 0 to pred(sourceNode.attributes.length) do with (sourceNode.attributes.item(i) as TdomAttr) do begin suppressThisAttr:= false; if FPrefixMapping or FSuppressXmlns then begin if IsXmlDefaultAttName(nodeName) then begin suppressThisAttr:= FSuppressXmlns; pfxUriList.add('',literalValue); end else if IsXmlPrefixedAttName(nodeName) then begin suppressThisAttr:= FSuppressXmlns; pfxUriList.add(xmlExtractLocalName(nodeName),literalValue); end; end; if not suppressThisAttr then attributeList.add(nodeName,literalValue); end; if FPrefixMapping then with pfxUriList do for i:= 0 to pred(length) do begin result:= writeStartPrefixMapping(loc,names[i],values[i]); if not result then break; end; if result then begin if sourceNode.hasChildNodes then begin result:= WriteStartElement(loc,sourceNode.nodeName,attributeList); if result then begin for i:= 0 to pred(sourceNode.childNodes.length) do begin result:= parseloop(sourceNode.childNodes.item(i)); if not result then break; end; end; if result then result:= WriteEndElement(loc,sourceNode.nodeName); end else result:= WriteEmptyElement(loc,sourceNode.nodeName,attributeList); if FPrefixMapping then with pfxUriList do for i:= pred(length) downto 0 do begin if not result then break; result:= writeEndPrefixMapping(loc,names[i]); end; end; finally attributeList.free; pfxUriList.free; end; end; ntText_Node: result:= writeWhileCheckingForAMPAndLT(loc,sourceNode.nodeValue); ntCDATA_Section_Node: result:= WriteCDATA(loc,sourceNode.nodeValue); ntEntity_Reference_Node: result:= WriteEntityRef(loc,sourceNode.nodeName); ntProcessing_Instruction_Node: result:= WriteProcessingInstruction(loc,sourceNode.nodeName,sourceNode.nodeValue); ntComment_Node: result:= WriteComment(loc,sourceNode.nodeValue); ntDocument_Node: begin versionNumber:= (sourceNode as TdomDocument).version; if versionNumber = '' then versionNumber:= '1.0'; // xxx necessary? result:= writeStartDocument(loc, versionNumber, (sourceNode as TdomDocument).encoding, STANDALONE_UNSPECIFIED); if result then begin for i:= 0 to pred(sourceNode.childNodes.length) do begin result:= parseloop(sourceNode.childNodes.item(i)); if not result then break; end; end; if result then result:= writeEndDocument(loc); end; ntDocument_Type_Node: result:= WriteDoctype(loc,sourceNode.nodeName, (sourceNode as TdomDocumentType).publicId, (sourceNode as TdomDocumentType).systemId, (sourceNode as TdomDocumentType).internalSubset); else result:= true; // xxx raise an exception instead? end; finally loc.free; end; end; function TXmlCustomDomReader.WriteCDATA(const locator: TdomLocator; const content: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.cdata(self,locator,content) else result:= true; end; function TXmlCustomDomReader.WriteCharRef(const locator: TdomLocator; const content: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.charRef(self,locator,content) else result:= true; end; function TXmlCustomDomReader.WriteComment(const locator: TdomLocator; const content: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.comment(self,locator,content) else result:= true; end; function TXmlCustomDomReader.WriteDoctype(const locator: TdomLocator; const aname, publicId, systemId, intSubset: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.doctype(self,locator,aname,publicId,systemId,intSubset) else result:= true; end; function TXmlCustomDomReader.WriteEmptyElement(const locator: TdomLocator; const tagName: wideString; const attributeList: TdomNameValueList): boolean; begin if assigned(NextHandler) then begin result:= NextHandler.startElement(self,locator,'',tagName,attributeList); if result then result:= NextHandler.endElement(self,locator,'',tagName); end else result:= true; end; function TXmlCustomDomReader.writeEndDocument(const locator: TdomLocator): boolean; begin if assigned(NextHandler) then result:= NextHandler.endDocument(self,locator) else result:= true; end; function TXmlCustomDomReader.WriteEndElement(const locator: TdomLocator; const tagName: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.endElement(self,locator,'',tagName) else result:= true; end; function TXmlCustomDomReader.writeEndPrefixMapping(const locator: TdomLocator; prefix: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.endPrefixMapping(self,locator,prefix) else result:= true; end; function TXmlCustomDomReader.WriteEntityRef(const locator: TdomLocator; const entityName: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.EntityRef(self,locator,entityName) else result:= true; end; function TXmlCustomDomReader.WritePCDATA(const locator: TdomLocator; const content: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.pcdata(self,locator,content) else result:= true; end; function TXmlCustomDomReader.WriteProcessingInstruction(const locator: TdomLocator; const targ, attribSequence : wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.ProcessingInstruction(self,locator,targ,attribSequence) else result:= true; end; function TXmlCustomDomReader.writeStartDocument(const locator: TdomLocator; version, encName: wideString; sdDl: TdomStandalone): boolean; begin if assigned(NextHandler) then result:= NextHandler.startDocument(self,locator,version,encName,sdDl) else result:= true; end; function TXmlCustomDomReader.WriteStartElement(const locator: TdomLocator; const tagName: wideString; const attributeList: TdomNameValueList): boolean; begin if assigned(NextHandler) then result:= NextHandler.startElement(self,locator,'',tagName,attributeList) else result:= true; end; function TXmlCustomDomReader.writeStartPrefixMapping(const locator: TdomLocator; prefix, uri: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.startPrefixMapping(self,locator,prefix,uri) else result:= true; end; // +++++++++++++++++++++++ TXmlStandardDomReader +++++++++++++++++++++++ function TXmlStandardDomReader.parse(const sourceNode: TDomNode): boolean; begin result:= parseloop(sourceNode); end; // +++++++++++++++++++++++ TXmlStandardCMReader +++++++++++++++++++++++ function TXmlStandardCMReader.writeAttributeDefinition(const locator: TdomLocator; aname, attType, bracket, defaultDecl, attValue: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.attributeDefinition(self,locator,aname,attType,bracket,defaultDecl,attValue) else result:= true; end; function TXmlStandardCMReader.writeDTDComment(const locator: TdomLocator; content: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.DTDComment(self,locator,content) else result:= true; end; function TXmlStandardCMReader.writeDTDProcessingInstruction(const locator: TdomLocator; targ, attribSequence : wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.DTDProcessingInstruction(self,locator,targ,attribSequence) else result:= true; end; function TXmlStandardCMReader.writeElementTypeDeclaration(const locator: TdomLocator; aname, data: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.elementTypeDeclaration(self,locator,aname,data) else result:= true; end; function TXmlStandardCMReader.writeEndAttListDeclaration(const locator: TdomLocator): boolean; begin if assigned(NextHandler) then result:= NextHandler.endAttListDeclaration(self,locator) else result:= true; end; function TXmlStandardCMReader.writeEndExtDtd(const locator: TdomLocator): boolean; begin if assigned(NextHandler) then result:= NextHandler.endExtDtd(self,locator) else result:= true; end; function TXmlStandardCMReader.writeEndIntDtd(const locator: TdomLocator): boolean; begin if assigned(NextHandler) then result:= NextHandler.endIntDtd(self,locator) else result:= true; end; function TXmlStandardCMReader.writeEntityDeclaration(const locator: TdomLocator; aname, entityValue, pubId, sysId, notaName: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.entityDeclaration(self,locator,aname,entityValue,pubId,sysId,notaName) else result:= true; end; function TXmlStandardCMReader.writeNotationDeclaration(const locator: TdomLocator; aname, pubId, sysId: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.notationDeclaration(self,locator,aname,pubId,sysId) else result:= true; end; function TXmlStandardCMReader.writeParameterEntityRef(const locator: TdomLocator; content: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.parameterEntityRef(self,locator,content) else result:= true; end; function TXmlStandardCMReader.writeStartAttListDeclaration(const locator: TdomLocator; aname: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.startAttListDeclaration(self,locator,aname) else result:= true; end; function TXmlStandardCMReader.writeStartExtDtd(const locator: TdomLocator; version, encName: wideString): boolean; begin if assigned(NextHandler) then result:= NextHandler.startExtDtd(self,locator,version,encName) else result:= true; end; function TXmlStandardCMReader.writeStartIntDtd(const locator: TdomLocator): boolean; begin if assigned(NextHandler) then result:= NextHandler.startIntDtd(self,locator) else result:= true; end; function TXmlStandardCMReader.parseloop(const sourceCMNode: TdomCMNode): boolean; var i: integer; snSystemId: wideString; versionNumber: wideString; loc: TdomLocator; function getBracket(CMAttrDef: TdomCMAttrDefinition): wideString; var k: integer; content: TdomCustomStr; begin if CMAttrDef.hasChildNodes then begin content:= TdomCustomStr.create; try with content do begin addWideChar('('); with CMAttrDef.ChildNodes do begin for k:= 0 to pred(Length) do begin // Write Sheffer stroke to separate TdomCMNameParticle or TdomCMNmtokenParticle names: if k > 0 then addWideString(' | '); // Write TdomCMNameParticle or TdomCMNmtokenParticle name: addWideString(item(k).nodeName); end; end; addWideChar(')'); result:= content.value; end; finally content.free; end; end else result:= ''; end; begin with sourceCMNode do begin case NodeType of ctExternalObject: snSystemId:= (sourceCMNode as TdomCMExternalObject).systemId; ctInternalObject: snSystemId:= (sourceCMNode as TdomCMInternalObject).systemId; else if assigned(FCMObject) then snSystemId:= FCMObject.systemId else snSystemId:= ''; end; {case ...} end; {with ...} loc:= TdomLocator.create(-1,-1,-1,-1,-1,snSystemId,sourceCMNode,nil); try case sourceCMNode.NodeType of ctAttributeList: begin result:= writeStartAttListDeclaration(loc,sourceCMNode.NodeName); if result then begin with TdomCMAttrList(sourceCMNode).childnodes do begin for i:= 0 to pred(length) do begin result:= writeAttributeDefinition(loc, Item(i).nodeName, (Item(i) as TdomCMAttrDefinition).AttributeType, getBracket(Item(i) as TdomCMAttrDefinition), (Item(i) as TdomCMAttrDefinition).DefaultDeclaration, Item(i).NodeValue); if not result then break; end; {for ...} end; {with ...} end; {if ...} if result then result:= writeEndAttListDeclaration(loc); end; ctComment: result:= writeDTDComment(loc, (sourceCMNode as TdomCMComment).data); ctElementTypeDeclaration: result:= writeElementTypeDeclaration(loc, sourceCMNode.nodeName, (sourceCMNode as TdomCMElementTypeDeclaration).Contentspec); ctEntityDeclaration: result:= writeEntityDeclaration(loc, sourceCMNode.nodeName, sourceCMNode.nodeValue, (sourceCMNode as TdomCMEntityDeclaration).publicId, (sourceCMNode as TdomCMEntityDeclaration).systemId, (sourceCMNode as TdomCMEntityDeclaration).notationName); ctExternalObject: begin versionNumber:= (sourceCMNode as TdomCMExternalObject).version; if versionNumber = '' then versionNumber:= '1.0'; // xxx necessary? result:= writeStartExtDTD(loc, versionNumber, (sourceCMNode as TdomCMExternalObject).encoding); if result then begin for i:= 0 to pred(sourceCMNode.childNodes.length) do begin result:= parseloop(sourceCMNode.childNodes.item(i)); if not result then break; end; end; if result then result:= writeEndExtDTD(loc); end; ctInternalObject: begin result:= writeStartIntDTD(loc); if result then begin for i:= 0 to pred(sourceCMNode.childNodes.length) do begin result:= parseloop(sourceCMNode.childNodes.item(i)); if not result then break; end; end; if result then result:= writeEndIntDTD(loc); end; ctNotationDeclaration: result:= writeNotationDeclaration(loc, sourceCMNode.nodeName, (sourceCMNode as TdomCMNotationDeclaration).publicId, (sourceCMNode as TdomCMNotationDeclaration).systemId); ctParameterEntityDeclaration: result:= true; // do nothing ctParameterEntityReference: result:= writeParameterEntityRef(loc, sourceCMNode.NodeName); ctProcessingInstruction: result:= writeDTDProcessingInstruction(loc, (sourceCMNode as TdomCMProcessingInstruction).target, (sourceCMNode as TdomCMProcessingInstruction).data); else result:= true; // xxx raise an exception instead? end; {case ...} finally loc.free; end; end; function TXmlStandardCMReader.parse(const sourceCMNode: TdomCMNode): boolean; begin result:= parseloop(sourceCMNode); end; // +++++++++++++++++++++++++ TXmlCustomParser +++++++++++++++++++++++++ constructor TXmlCustomParser.create(aOwner: TComponent); begin inherited; FDOMImpl:= nil; end; procedure TXmlCustomParser.setDomImpl(const impl: TDomImplementation); begin FDOMImpl:= impl; if assigned(impl) then impl.FreeNotification(Self); end; procedure TXmlCustomParser.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent,Operation); if (Operation = opRemove) and (AComponent = FDomImpl) then FDomImpl:= nil; end; // ++++++++++++++++++++++++++ TXmlCMAnalyzer ++++++++++++++++++++++++++ constructor TXmlCMAnalyzer.create(aOwner: TComponent); begin inherited; FCMBuilder:= TXmlCMBuilder.create(self); // xxx will be replaced by TXmlASBuilder in the future. FCMReader:= TXmlStandardCMReader.create(self); FCMReader.NextHandler:= FCMBuilder; FCMReader.DOMImpl:= FDOMImpl; FDtdReader:= TXmlStandardDtdReader.create(self); FDtdReader.NextHandler:= FCMBuilder; FDtdReader.DOMImpl:= FDOMImpl; end; destructor TXmlCMAnalyzer.destroy; begin FCMReader.free; FCMBuilder.free; // xxx will be replaced by TXmlASBuilder in the future. FDtdReader.free; inherited; end; procedure TXmlCMAnalyzer.setDomImpl(const impl: TDomImplementation); begin inherited; FCMReader.DOMImpl:= impl; FDtdReader.DOMImpl:= impl; end; function TXmlCMAnalyzer.analyzeCM(const source: TdomCustomCMIEObject; const target: TdomCMObject): boolean; begin FCMBuilder.contentModel:= target; result:= FCMReader.parse(source); end; procedure TXmlCMAnalyzer.analyzeIntDTDStr( str: wideString; const target: TdomCMObject); var WStrStream: TdomWideStringStream; InputSrc: TXmlInputSource; begin FCMBuilder.FContentModel:= target; if str = '' then exit; if str[1] <> #$feff then str:= concat(wideString(#$feff),str); WStrStream:= TdomWideStringStream.createFromString(str); try InputSrc:= TXmlInputSource.create(WStrStream,'','',1); try // Note: Testing for illegal XML or Text Declaration is not necessary here. if not FDtdReader.parseInternalSubset(InputSrc) then raise EParserException.create('Parser error.'); // xxx ??? finally InputSrc.free; end; {try} finally WStrStream.free; end; {try} end; { TXmlToDomParser } constructor TXmlToDomParser.create(aOwner: TComponent); // Note: If you derive your own parser class from TXmlToDomParser // which is calling the inherited create constructor of TXmlToDomParser // you should take care of freeing the Handlers, Builders and Readers // created here which are not longer of use. Code example: // // type TMyParser = class(TXmlToDomParser) ... // type TMyXMLReader = class(TXmlStandardDocReader) ... // // constructor TMyParser.create(aOwner:TComponent); // begin // Inherited create(aOwner); // FDocReader.free; // FDocReader:= TMyXMLReader.create; // FDocXMLReader.NextHandler:= FWFTestContentHandler; // end; begin inherited; FDocReader:= TXmlStandardDocReader.create(self); FWFTestContentHandler:= TXmlWFTestContentHandler.create(self); FDocBuilder:= TXmlDocBuilder.create(self); FDtdReader:= TXmlStandardDtdReader.create(self); FWFTestDtdHandler:= TXmlWFTestDtdHandler.create(self); FDtdBuilder:= TXmlDtdBuilder.create(self); FDocReader.DOMImpl:= FDOMImpl; FDtdReader.DOMImpl:= FDOMImpl; FDocReader.NextHandler:= FWFTestContentHandler; FWFTestContentHandler.NextHandler:= FDocBuilder; FDtdReader.NextHandler:= FWFTestDtdHandler; FWFTestDtdHandler.NextHandler:= FDtdBuilder; FTabWidth:= 1; end; procedure TXmlToDomParser.doExternalSubset(const parentSystemId: wideString; var publicId, systemId: wideString; var stream: TStream; var action: TXmlParserAction); begin action:= paFail; if assigned(FDOMImpl) then FDOMImpl.doExternalParsedEntity(parentSystemId,publicId,systemId,stream,action); end; function TXmlToDomParser.processDocFile(const pubId, sysId: wideString): boolean; var MStream: TMemoryStream; begin if sysId = '' then raise EAccessViolation.create('Filename not specified.'); MStream:= TMemoryStream.create; try MStream.LoadFromFile(sysId); result:= processDocStream(MStream,pubId,sysId); finally MStream.free; end; {try} end; function TXmlToDomParser.processDocSourceCode(const intDtdSourceCode: TXmlSourceCode; const pubId, sysId: wideString): boolean; var content: TdomCustomStr; i: integer; begin if not assigned(intDtdSourceCode) then raise EAccessViolation.create('Stream not specified.'); content:= TdomCustomStr.create; try for i:= 0 to intDtdSourceCode.Count -1 do content.addWideString(TXmlSourceCodePiece(intDtdSourceCode[i]).text); result:= processDocString(content.value,pubId,sysId); finally content.free; end; end; function TXmlToDomParser.processDocStream(const stream: TStream; const pubId, sysId: wideString): boolean; var InputSrc: TXmlInputSource; begin if not assigned(stream) then raise EAccessViolation.create('Stream not specified.'); InputSrc:= TXmlInputSource.create(stream,pubId,sysId,FTabWidth); try if InputSrc.hasMalformedDecl or not ( InputSrc.declType in [ DT_XML_DECLARATION, DT_XML_OR_TEXT_DECLARATION, DT_UNSPECIFIED] ) then begin sendErrorNotification(ET_INVALID_XML_DECL); result:= false; end else result:= FDocReader.parse(InputSrc); finally InputSrc.free; end; {try} end; function TXmlToDomParser.processDocString(const str: String; const pubId, sysId: wideString): boolean; var StrStream: TStringStream; begin if str = '' then raise EAccessViolation.create('Empty string.'); StrStream:= TStringStream.create(str); try result:= processDocStream(StrStream,pubId,sysId); finally StrStream.free; end; {try} end; function TXmlToDomParser.processDocWideString(str: wideString; const pubId, sysId: wideString): boolean; var WStrStream: TdomWideStringStream; begin if str = '' then raise EAccessViolation.create('Empty string.'); if str[1] <> #$feff then str:= concat(wideString(#$feff),str); WStrStream:= TdomWideStringStream.createFromString(str); try result:= processDocStream(WStrStream,pubId,sysId); finally WStrStream.free; end; {try} end; function TXmlToDomParser.processDtd(const doc: TdomDocument): boolean; var PId,SId: wideString; extDtdStream: TStream; action: TXmlParserAction; intSubsetData,intSubsetPubId,intSubsetSysId,extSubsetPubId,extSubsetSysId: wideString; begin result:= true; if not assigned(doc) then exit; if not assigned(doc.doctype) then exit; intSubsetPubId:= ''; // xxx Delete this ??? intSubsetSysId:= doc.systemId; with doc.doctype do begin intSubsetData:= internalSubset; extSubsetPubId:= publicId; extSubsetSysId:= systemId; end; // Evaluate internal subset: if intSubsetData <> '' then begin result:= processIntDtdWideString(intSubsetData,intSubsetPubId,intSubsetSysId); if not result then exit; // error while parsing? end; // xxx Make external content model evaluation optional? // xxx Evaluation of standalone! // Evaluate external subset: if (extSubsetPubId <> '') or (extSubsetSysId <> '') then begin extDtdStream:= nil; PId:= extSubsetPubId; SId:= extSubsetSysId; try doExternalSubset(intSubsetSysId,PId,SId,extDtdStream,action); if action = paFail then begin sendErrorNotification(ET_EXTERNAL_SUBSET_NOT_FOUND); result:= false; exit; end; if assigned(extDtdStream) then result:= processExtDtdStream(extDtdStream,PId,SId); finally if assigned(extDtdStream) then extDtdStream.free; end; {try ... finally ...} end; {if (extSubsetPubId <> '') ...} end; function TXmlToDomParser.processExtDtdFile(const pubId, sysId: wideString): boolean; var MStream: TMemoryStream; begin if sysId = '' then raise EAccessViolation.create('Filename not specified.'); MStream:= TMemoryStream.create; try MStream.LoadFromFile(sysId); result:= processExtDtdStream(MStream,pubId,sysId); finally MStream.free; end; {try} end; function TXmlToDomParser.processExtDtdSourceCode(const intDtdSourceCode: TXmlSourceCode; const pubId, sysId: wideString): boolean; var content: TdomCustomStr; i: integer; begin if not assigned(intDtdSourceCode) then raise EAccessViolation.create('Stream not specified.'); content:= TdomCustomStr.create; try for i:= 0 to pred(intDtdSourceCode.Count) do content.addWideString(TXmlSourceCodePiece(intDtdSourceCode[i]).text); result:= processExtDtdString(content.value,pubId,sysId); finally content.free; end; end; function TXmlToDomParser.processExtDtdStream(const stream: TStream; const pubId, sysId: wideString): boolean; var InputSrc: TXmlInputSource; begin if not assigned(stream) then raise EAccessViolation.create('Stream not specified.'); InputSrc:= TXmlInputSource.create(stream,pubId,sysId,FTabWidth); try if InputSrc.hasMalformedDecl or not ( InputSrc.declType in [ DT_TEXT_DECLARATION, DT_XML_OR_TEXT_DECLARATION, DT_UNSPECIFIED] ) then begin sendErrorNotification(ET_INVALID_TEXT_DECL); result:= false; end else result:= FDtdReader.parseExternalSubset(InputSrc); finally InputSrc.free; end; {try} end; function TXmlToDomParser.processExtDtdString(const str: String; const pubId, sysId: wideString): boolean; var StrStream: TStringStream; begin if str = '' then raise EAccessViolation.create('Empty string.'); StrStream:= TStringStream.create(str); try result:= processExtDtdStream(StrStream,pubId,sysId); finally StrStream.free; end; {try} end; function TXmlToDomParser.processExtDtdWideString(str: wideString; const pubId, sysId: wideString): boolean; var WStrStream: TdomWideStringStream; begin if str = '' then raise EAccessViolation.create('Empty string.'); if str[1] <> #$feff then str:= concat(wideString(#$feff),str); WStrStream:= TdomWideStringStream.createFromString(str); try result:= processExtDtdStream(WStrStream,pubId,sysId); finally WStrStream.free; end; {try} end; function TXmlToDomParser.processIntDtdFile(const pubId, sysId: wideString): boolean; var MStream: TMemoryStream; begin if sysId = '' then raise EAccessViolation.create('Filename not specified.'); MStream:= TMemoryStream.create; try MStream.LoadFromFile(sysId); result:= processIntDtdStream(MStream,pubId,sysId); finally MStream.free; end; {try} end; function TXmlToDomParser.processIntDtdSourceCode(const intDtdSourceCode: TXmlSourceCode; const pubId, sysId: wideString): boolean; var content: TdomCustomStr; i: integer; begin if not assigned(intDtdSourceCode) then raise EAccessViolation.create('Stream not specified.'); content:= TdomCustomStr.create; try for i:= 0 to pred(intDtdSourceCode.Count) do content.addWideString(TXmlSourceCodePiece(intDtdSourceCode[i]).text); result:= processIntDtdString(content.value,pubId,sysId); finally content.free; end; end; function TXmlToDomParser.processIntDtdStream(const stream: TStream; const pubId, sysId: wideString): boolean; var InputSrc: TXmlInputSource; begin if not assigned(stream) then raise EAccessViolation.create('Stream not specified.'); InputSrc:= TXmlInputSource.create(stream,pubId,sysId,FTabWidth); try if InputSrc.hasMalformedDecl or not ( InputSrc.declType in [ DT_TEXT_DECLARATION, DT_XML_OR_TEXT_DECLARATION, DT_UNSPECIFIED] ) then begin sendErrorNotification(ET_INVALID_TEXT_DECL); result:= false; end else result:= FDtdReader.parseInternalSubset(InputSrc); finally InputSrc.free; end; end; function TXmlToDomParser.processIntDtdString(const str: String; const pubId, sysId: wideString): boolean; var StrStream: TStringStream; begin if str = '' then raise EAccessViolation.create('Empty string.'); StrStream:= TStringStream.create(str); try result:= processIntDtdStream(StrStream,pubId,sysId); finally StrStream.free; end; {try} end; function TXmlToDomParser.processIntDtdWideString(str: wideString; const pubId, sysId: wideString): boolean; var WStrStream: TdomWideStringStream; begin if str = '' then raise EAccessViolation.create('Empty string.'); if str[1] <> #$feff then str:= concat(wideString(#$feff),str); WStrStream:= TdomWideStringStream.createFromString(str); try result:= processIntDtdStream(WStrStream,pubId,sysId); finally WStrStream.free; end; {try} end; function TXmlToDomParser.sendErrorNotification(const xmlErrorType: TXmlErrorType): boolean; var error: TdomError; begin error:= TdomError.createFromLocator(xmlErrorType,nil,''); try if assigned(FDomImpl) then begin result:= FDomImpl.handleError(self,error); end else if error.severity = DOM_SEVERITY_FATAL_ERROR then result:= false else result:= true; finally error.free; end; end; procedure TXmlToDomParser.setDomImpl(const impl: TDomImplementation); begin inherited; FDocReader.DOMImpl:= impl; FDtdReader.DOMImpl:= impl; end; procedure TXmlToDomParser.setTabWidth(const value: integer); begin FTabWidth:= value; end; procedure TXmlToDomParser.docSourceCodeToDom(const docSourceCode: TXmlSourceCode; const pubId, sysId: wideString; const refNode: TdomNode); begin FDocBuilder.referenceNode:= refNode; if refNode is TdomDocument then FWFTestContentHandler.testRootFound:= true else FWFTestContentHandler.testRootFound:= false; if not processDocSourceCode(docSourceCode,pubId,sysId) then raise EParserException.create('Parser error.'); end; procedure TXmlToDomParser.docStreamToDom(const stream: TStream; const pubId, sysId: wideString; const refNode: TdomNode); begin FDocBuilder.referenceNode:= refNode; if refNode is TdomDocument then FWFTestContentHandler.testRootFound:= true else FWFTestContentHandler.testRootFound:= false; if not processDocStream(stream,pubId,sysId) then raise EParserException.create('Parser error.'); end; procedure TXmlToDomParser.docStringToDom(const str: string; const pubId, sysId: wideString; const refNode: TdomNode); begin FDocBuilder.referenceNode:= refNode; if refNode is TdomDocument then FWFTestContentHandler.testRootFound:= true else FWFTestContentHandler.testRootFound:= false; if not processDocString(str,pubId,sysId) then raise EParserException.create('Parser error.'); end; procedure TXmlToDomParser.docWideStringToDom( str: wideString; const pubId, sysId: wideString; const refNode: TdomNode); begin FDocBuilder.referenceNode:= refNode; if refNode is TdomDocument then FWFTestContentHandler.testRootFound:= true else FWFTestContentHandler.testRootFound:= false; if not processDocWideString(str,pubId,sysId) then raise EParserException.create('Parser error.'); end; procedure TXmlToDomParser.extDtdSourceCodeToDom(const ExtDtdSourceCode: TXmlSourceCode; const pubId, sysId: wideString; const refNode: TdomCMNode); begin FDtdBuilder.extContentModel:= (refNode as TdomCMExternalObject); if not processExtDtdSourceCode(ExtDtdSourceCode,pubId,sysId) then raise EParserException.create('Parser error.'); end; procedure TXmlToDomParser.extDtdStreamToDom(const stream: TStream; const pubId, sysId: wideString; const refNode: TdomCMNode); begin FDtdBuilder.extContentModel:= (refNode as TdomCMExternalObject); if not processExtDtdStream(Stream,pubId,sysId) then raise EParserException.create('Parser error.'); end; procedure TXmlToDomParser.extDtdStringToDom(const str: string; const pubId, sysId: wideString; const refNode: TdomCMNode); begin FDtdBuilder.extContentModel:= (refNode as TdomCMExternalObject); if not processExtDtdString(str,pubId,sysId) then raise EParserException.create('Parser error.'); end; procedure TXmlToDomParser.extDtdWideStringToDom( str: wideString; const pubId, sysId: wideString; const refNode: TdomCMNode); begin FDtdBuilder.extContentModel:= (refNode as TdomCMExternalObject); if not processExtDtdWideString(str,pubId,sysId) then raise EParserException.create('Parser error.'); end; procedure TXmlToDomParser.intDtdSourceCodeToDom(const intDtdSourceCode: TXmlSourceCode; const pubId, sysId: wideString; const refNode: TdomCMNode); begin FDtdBuilder.intContentModel:= (refNode as TdomCMInternalObject); if not processIntDtdSourceCode(intDtdSourceCode,pubId,sysId) then raise EParserException.create('Parser error.'); end; procedure TXmlToDomParser.intDtdStreamToDom(const stream: TStream; const pubId, sysId: wideString; const refNode: TdomCMNode); begin FDtdBuilder.intContentModel:= (refNode as TdomCMInternalObject); if not processIntDtdStream(stream,pubId,sysId) then raise EParserException.create('Parser error.'); end; procedure TXmlToDomParser.intDtdStringToDom(const str: string; const pubId, sysId: wideString; const refNode: TdomCMNode); begin FDtdBuilder.intContentModel:= (refNode as TdomCMInternalObject); if not processIntDtdString(str,pubId,sysId) then raise EParserException.create('Parser error.'); end; procedure TXmlToDomParser.intDtdWideStringToDom( str: wideString; const pubId, sysId: wideString; const refNode: TdomCMNode); begin FDtdBuilder.intContentModel:= (refNode as TdomCMInternalObject); if not processIntDtdWideString(str,pubId,sysId) then raise EParserException.create('Parser error.'); end; function TXmlToDomParser.fileToDom(const filename: TFileName): TdomDocument; var cmObj: TdomCMObject; intCMObj: TdomCMInternalObject; extCMObj: TdomCMExternalObject; begin if not assigned(FDOMImpl) then raise EAccessViolation.create('DOMImplementation not specified.'); if Filename = '' then raise EAccessViolation.create('Filename not specified.'); result:= FDOMImpl.createDocument('dummy',nil); result.clear; // Delete the dummy root element cmObj:= FDOMImpl.createCMObject(filename); intCMObj:= FDOMImpl.createCMInternalObject('',''); extCMObj:= FDOMImpl.createCMExternalObject('',''); cmObj.setInternalCM(intCMObj); cmObj.setExternalCM(extCMObj); result.setContentModel(cmObj); try FDocBuilder.referenceNode:= result; FDtdBuilder.extContentModel:= result.contentModel.externalCM; FDtdBuilder.intContentModel:= result.contentModel.internalCM; if not processDocFile('',filename) then raise EParserException.create('Parser error.'); if not processDtd(result) then raise EParserException.create('Parser error.'); except FDOMImpl.FreeCMExternalObject(extCMObj); FDOMImpl.FreeCMInternalObject(intCMObj); FDOMImpl.freeCMObject(cmObj); FDOMImpl.freeDocument(result); raise; end; FDocBuilder.referenceNode:= nil; FDtdBuilder.extContentModel:= nil; FDtdBuilder.intContentModel:= nil; end; function TXmlToDomParser.sourceCodeToDom(const sc: TXmlSourceCode): TdomDocument; var content: TdomCustomStr; i: integer; begin if not assigned(sc) then raise EAccessViolation.create('TXmlSourceCode not specified.'); content:= TdomCustomStr.create; try for i:= 0 to pred(sc.count) do content.addWideString(TXmlSourceCodePiece(sc[i]).text); result:= wideStringToDom(content.value); finally content.free; end; end; function TXmlToDomParser.streamToDom(const stream: TStream): TdomDocument; var cmObj: TdomCMObject; intCMObj: TdomCMInternalObject; extCMObj: TdomCMExternalObject; begin if not assigned(FDOMImpl) then raise EAccessViolation.create('DOMImplementation not specified.'); if not assigned(stream) then raise EAccessViolation.create('Stream not specified.'); result:= FDOMImpl.createDocument('dummy',nil); result.clear; // Delete the dummy root element cmObj:= FDOMImpl.createCMObject(''); intCMObj:= FDOMImpl.createCMInternalObject('',''); extCMObj:= FDOMImpl.createCMExternalObject('',''); cmObj.setInternalCM(intCMObj); cmObj.setExternalCM(extCMObj); result.setContentModel(cmObj); try FDocBuilder.referenceNode:= result; FDtdBuilder.extContentModel:= result.contentModel.externalCM; FDtdBuilder.intContentModel:= result.contentModel.internalCM; if not processDocStream(stream,'','') then raise EParserException.create('Parser error.'); if not processDtd(result) then raise EParserException.create('Parser error.'); except FDOMImpl.FreeCMExternalObject(extCMObj); FDOMImpl.FreeCMInternalObject(intCMObj); FDOMImpl.freeCMObject(cmObj); FDOMImpl.freeDocument(result); raise; end; FDocBuilder.referenceNode:= nil; FDtdBuilder.extContentModel:= nil; FDtdBuilder.intContentModel:= nil; end; function TXmlToDomParser.stringToDom(const str: String): TdomDocument; var cmObj: TdomCMObject; intCMObj: TdomCMInternalObject; extCMObj: TdomCMExternalObject; begin if not assigned(FDOMImpl) then raise EAccessViolation.create('DOMImplementation not specified.'); result:= FDOMImpl.createDocument('dummy',nil); result.clear; // Delete the dummy root element cmObj:= FDOMImpl.createCMObject(''); intCMObj:= FDOMImpl.createCMInternalObject('',''); extCMObj:= FDOMImpl.createCMExternalObject('',''); cmObj.setInternalCM(intCMObj); cmObj.setExternalCM(extCMObj); result.setContentModel(cmObj); try FDocBuilder.referenceNode:= result; FDtdBuilder.extContentModel:= result.contentModel.externalCM; FDtdBuilder.intContentModel:= result.contentModel.internalCM; if not processDocString(str,'','') then raise EParserException.create('Parser error.'); if not processDtd(result) then raise EParserException.create('Parser error.'); except FDOMImpl.FreeCMExternalObject(extCMObj); FDOMImpl.FreeCMInternalObject(intCMObj); FDOMImpl.freeCMObject(cmObj); FDOMImpl.freeDocument(result); raise; end; FDocBuilder.referenceNode:= nil; FDtdBuilder.extContentModel:= nil; FDtdBuilder.intContentModel:= nil; end; function TXmlToDomParser.wideStringToDom(str: wideString): TdomDocument; var cmObj: TdomCMObject; intCMObj: TdomCMInternalObject; extCMObj: TdomCMExternalObject; begin if not assigned(FDOMImpl) then raise EAccessViolation.create('DOMImplementation not specified.'); result:= FDOMImpl.createDocument('dummy',nil); result.clear; // Delete the dummy root element cmObj:= FDOMImpl.createCMObject(''); intCMObj:= FDOMImpl.createCMInternalObject('',''); extCMObj:= FDOMImpl.createCMExternalObject('',''); cmObj.setInternalCM(intCMObj); cmObj.setExternalCM(extCMObj); result.setContentModel(cmObj); try FDocBuilder.referenceNode:= result; FDtdBuilder.extContentModel:= result.contentModel.externalCM; FDtdBuilder.intContentModel:= result.contentModel.internalCM; if not processDocWideString(str,'','') then raise EParserException.create('Parser error.'); if not processDtd(result) then raise EParserException.create('Parser error.'); except FDOMImpl.FreeCMExternalObject(extCMObj); FDOMImpl.FreeCMInternalObject(intCMObj); FDOMImpl.freeCMObject(cmObj); FDOMImpl.freeDocument(result); raise; end; FDocBuilder.referenceNode:= nil; FDtdBuilder.extContentModel:= nil; FDtdBuilder.intContentModel:= nil; end; { TDomToXmlParser } constructor TDomToXmlParser.create(aOwner: TComponent); begin inherited; FDomReader:= TXmlStandardDomReader.create(self); FStreamBuilder:= TXmlStreamBuilder.create(self); FDomReader.NextHandler:= FStreamBuilder; end; function TDomToXmlParser.getNewLine: TdomNewLineType; begin result:= FStreamBuilder.newLine; end; procedure TDomToXmlParser.setNewLine(const value: TdomNewLineType); begin FStreamBuilder.newLine:= value; end; function TDomToXmlParser.writeToStream(const wnode: TdomNode; const encoding: wideString; const destination: TStream): boolean; begin if not assigned(FDOMImpl) then raise EAccessViolation.create('DOMImplementation not specified.'); if not assigned(destination) then raise EAccessViolation.create('Destination stream not specified.'); if not assigned(wnode) then raise EAccessViolation.create('Source node not specified.'); FDomReader.DOMImpl:= FDOMImpl; FStreamBuilder.destination:= destination; FStreamBuilder.defaultEncoding:= encoding; // Raises an ENot_Supported_Err, if the specified encoding is not supported result:= FDomReader.parse(wnode); end; function TDomToXmlParser.writeToString(const wnode: TdomNode; const encoding: wideString; out S: string): boolean; var xmlStream: TStringStream; begin case StrToEncoding(encoding) of etUTF16BE, etUTF16LE: raise ENot_Supported_Err.create('Encoding not supported error.'); end; xmlStream:= TStringStream.create(''); try result:= writeToStream(wnode,encoding,xmlStream); S:= xmlStream.dataString; finally xmlStream.free; end; end; function TDomToXmlParser.writeToWideString(const wnode: TdomNode; out S: wideString): boolean; var xmlStream: TdomWideStringStream; begin xmlStream:= TdomWideStringStream.create; try result:= writeToStream(wnode,'UTF-16BE',xmlStream); S:= xmlStream.dataString; finally xmlStream.free; end; end; { TCMToXmlParser } constructor TCMToXmlParser.create(aOwner: TComponent); begin inherited; FCMReader:= TXmlStandardCMReader.create(self); FStreamBuilder:= TXmlStreamBuilder.create(self); FCMReader.NextHandler:= FStreamBuilder; end; function TCMToXmlParser.getNewLine: TdomNewLineType; begin result:= FStreamBuilder.newLine; end; procedure TCMToXmlParser.setNewLine(const value: TdomNewLineType); begin FStreamBuilder.newLine:= value; end; function TCMToXmlParser.writeToStream(const wnode: TdomCMNode; const encoding: wideString; const destination: TStream): boolean; begin if not assigned(FDOMImpl) then raise EAccessViolation.create('DOMImplementation not specified.'); if not assigned(destination) then raise EAccessViolation.create('Destination stream not specified.'); if not assigned(wnode) then raise EAccessViolation.create('Source node not specified.'); FCMReader.DOMImpl:= FDOMImpl; FStreamBuilder.destination:= destination; FStreamBuilder.defaultEncoding:= encoding; // Raises an ENot_Supported_Err, if the specified encoding is not supported result:= FCMReader.parse(wnode); end; function TCMToXmlParser.writeToString(const wnode: TdomCMNode; const encoding: wideString; out S: string): boolean; var xmlStream: TStringStream; begin case StrToEncoding(encoding) of etUTF16BE, etUTF16LE: raise ENot_Supported_Err.create('Encoding not supported error.'); end; xmlStream:= TStringStream.create(''); try result:= writeToStream(wnode,encoding,xmlStream); S:= xmlStream.dataString; finally xmlStream.free; end; end; function TCMToXmlParser.writeToWideString(const wnode: TdomCMNode; out S: wideString): boolean; var xmlStream: TdomWideStringStream; begin xmlStream:= TdomWideStringStream.create; try result:= writeToStream(wnode,'UTF-16BE',xmlStream); S:= xmlStream.dataString; finally xmlStream.free; end; end; { TdomXPathSyntaxNodeStack } constructor TdomXPathSyntaxNodeStack.create; begin inherited; FNodeList:= TList.create; end; destructor TdomXPathSyntaxNodeStack.destroy; begin clear; FNodeList.free; inherited; end; procedure TdomXPathSyntaxNodeStack.clear; var i: integer; begin for i:= 0 to pred(FNodeList.Count) do TdomXPathSyntaxNode(FNodeList[i]).free; end; function TdomXPathSyntaxNodeStack.getLength: integer; begin result:= FNodeList.count; end; function TdomXPathSyntaxNodeStack.peek(offset: integer): TdomXPathSyntaxNode; var index: integer; begin index:= pred(FNodeList.count)-offset; if (index < 0) or (index >= FNodeList.count) then result:= nil else result:= TdomXPathSyntaxNode(FNodeList.List^[index]); end; function TdomXPathSyntaxNodeStack.pop: TdomXPathSyntaxNode; begin result:= FNodeList[pred(FNodeList.count)]; FNodeList.delete(pred(FNodeList.count)); end; function TdomXPathSyntaxNodeStack.push(node: TdomXPathSyntaxNode): TdomXPathSyntaxNode; begin result:= TdomXPathSyntaxNode(FNodeList.add(node)); end; { TdomXPathSyntaxNode } constructor TdomXPathSyntaxNode.create(const value: wideString); begin FLeft:= nil; FRight:= nil; FValue:= value; end; destructor TdomXPathSyntaxNode.destroy; begin if assigned (FLeft) then FLeft.free; if assigned (FRight) then FRight.free; inherited; end; function TdomXPathSyntaxNode.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; begin // By default pass the evaluation to the left child XPath syntax node. // If none is present then raise an exception. if assigned(left) then begin result:= left.evaluate(contextNode,oldResult,resolver); end else begin if assigned(oldResult) then oldResult.free; raise ENot_Supported_Err.create('Not supported error.'); end; end; { TdomXPathStep } function TdomXPathStep.addStep(const step: TdomXPathStep): boolean; begin if not assigned(right) then begin right:= step; result:= true; end else begin if right is TdomXPathStep then result:= TdomXPathStep(right).addStep(step) else result:= false; end; end; function TdomXPathStep.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; begin if assigned(oldResult) then oldResult.Free; raise ENot_Supported_Err.create('Not supported error.'); // Remark: To evaluate a Step the evaluate2 function must be used. end; function TdomXPathStep.evaluate2(const oldSnapshotResult: TdomXPathSnapshotResult; const resolver: TdomXPathNSResolver): TdomXPathSnapshotResult; var newResult: TdomXPathSnapshotResult; begin if not assigned(oldSnapshotResult) then raise EXPath_Type_Err.create('XPath type error.'); if left is TdomXPathCustomAxisName then begin if oldSnapshotResult.snapshotLength > 0 then begin newResult:= TdomXPathCustomAxisName(left).evaluate2(oldSnapshotResult,resolver); if right is TdomXPathStep then result:= TdomXPathStep(right).evaluate2(newResult,resolver) else result:= newResult; end else result:= oldSnapshotResult; end else raise EXPath_Type_Err.create('XPath type error.'); end; { TdomXPathCustomAxisName } constructor TdomXPathCustomAxisName.create(const avalue: wideString); begin inherited; FAxisType:= XPATH_FORWARD_AXIS; FPrincipalNodeType:= ntElement_Node; end; function TdomXPathCustomAxisName.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; begin if assigned(oldResult) then oldResult.Free; raise ENot_Supported_Err.create('Not supported error.'); // Remark: To evaluate an AxisName the evaluate2 function must be used. end; function TdomXPathCustomAxisName.evaluate2(const oldSnapshotResult: TdomXPathSnapshotResult; const resolver: TdomXPathNSResolver): TdomXPathSnapshotResult; var i: integer; n: TdomNode; axisNodeSnapshot,inputSnapshot,nodeTestSnapshot: TdomXPathSnapshotResult; function evaluatePredicate(const snapshot: TdomXPathSnapshotResult):TdomXPathSnapshotResult; begin if assigned(right) then begin if right is TdomXPathPredicate then begin if snapshot.snapshotLength > 0 then result:= TdomXPathPredicate(right).evaluate2(snapshot,resolver) else result:= snapshot; end else begin snapshot.free; raise EXPath_Type_Err.create('XPath type error.'); end; end else result:= snapshot; end; function evaluateNodeTest(const snapshot: TdomXPathSnapshotResult):TdomXPathSnapshotResult; begin if assigned(left) then begin if left is TdomXPathNodeTest then begin if snapshot.snapshotLength > 0 then result:= TdomXPathNodeTest(left).evaluate2(snapshot,FPrincipalNodeType,resolver) else result:= snapshot; end else begin snapshot.free; raise EXPath_Type_Err.create('XPath type error.'); end; end else raise EXPath_Type_Err.create('XPath type error.'); end; begin if not assigned(oldSnapshotResult) then raise EXPath_Type_Err.create('XPath type error.'); try result:= TdomXPathSnapshotResult.create; result.axisType:= axisType; try with oldSnapshotResult do begin for i:= 0 to pred(snapshotLength) do begin n:= snapshotItem(i); if assigned(n) then begin inputSnapshot:= getAxisNodeSnapshot(n); nodeTestSnapshot:= evaluateNodeTest(inputSnapshot); axisNodeSnapshot:= evaluatePredicate(nodeTestSnapshot); result.addSnapshotResult(axisNodeSnapshot); end; end; end; except result.free; raise; end; finally oldSnapshotResult.free; end; end; { TdomXPathAxisNameAncestor } constructor TdomXPathAxisNameAncestor.create(const avalue: wideString); begin inherited; FAxisType:= XPATH_REVERSE_AXIS; end; function TdomXPathAxisNameAncestor.getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; var n: TdomNode; begin result:= TdomXPathSnapshotResult.create; result.axisType:= axisType; if assigned(contextNode) then begin case contextNode.nodeType of ntElement_Node,ntText_Node,ntCDATA_Section_Node,ntEntity_Reference_Node, ntProcessing_Instruction_Node,ntComment_Node: n:= contextNode.parentNode; ntAttribute_Node: n:= TdomAttr(contextNode).ownerElement; ntXPath_Namespace_Node: n:= TdomXPathNamespace(contextNode).ownerElement; else n:= nil; end; while assigned(n) do begin result.add(n); n:= n.parentNode; end; end; end; { TdomXPathAxisNameAncestorOrSelf } constructor TdomXPathAxisNameAncestorOrSelf.create(const avalue: wideString); begin inherited; FAxisType:= XPATH_REVERSE_AXIS; end; function TdomXPathAxisNameAncestorOrSelf.getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; var n: TdomNode; begin result:= TdomXPathSnapshotResult.create; result.axisType:= axisType; if assigned(contextNode) then begin result.add(contextNode); case contextNode.nodeType of ntElement_Node,ntText_Node,ntCDATA_Section_Node,ntEntity_Reference_Node, ntProcessing_Instruction_Node,ntComment_Node: n:= contextNode.parentNode; ntAttribute_Node: n:= TdomAttr(contextNode).ownerElement; ntXPath_Namespace_Node: n:= TdomXPathNamespace(contextNode).ownerElement; else n:= nil; end; while assigned(n) do begin result.add(n); n:= n.parentNode; end; end; end; { TdomXPathAxisNameAttribute } constructor TdomXPathAxisNameAttribute.create(const avalue: wideString); begin inherited; FPrincipalNodeType:= ntAttribute_Node; end; function TdomXPathAxisNameAttribute.getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; var i: integer; begin // xxx Namespace definition attributes must be left out! result:= TdomXPathSnapshotResult.create; result.axisType:= axisType; if assigned(contextNode) then with contextNode do if nodeType = ntElement_Node then with attributes do for i:= 0 to pred(length) do result.add(item(i)); end; { TdomXPathAxisNameChild } function TdomXPathAxisNameChild.getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; var i: integer; begin result:= TdomXPathSnapshotResult.create; result.axisType:= axisType; if assigned(contextNode) then with contextNode.childNodes do for i:= 0 to pred(length) do result.add(item(i)); end; { TdomXPathAxisNameDescendant } function TdomXPathAxisNameDescendant.getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; var n: TdomNode; begin result:= TdomXPathSnapshotResult.create; result.axisType:= axisType; if assigned(contextNode) then begin with contextNode.ownerDocument.createNodeIterator(contextNode, [ ntElement_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node, ntProcessing_Instruction_Node, ntComment_Node ], nil, false) do begin n:= NextNode; if n = contextNode then n:= NextNode; while assigned(n) do begin result.add(n); n:= NextNode; end; detach; end; contextNode.ownerDocument.clearInvalidNodeIterators; end; end; { TdomXPathAxisNameDescendantOrSelf } function TdomXPathAxisNameDescendantOrSelf.getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; var n: TdomNode; begin result:= TdomXPathSnapshotResult.create; result.axisType:= axisType; if assigned(contextNode) then begin with contextNode.ownerDocument.createNodeIterator(contextNode, [ ntElement_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node, ntProcessing_Instruction_Node, ntComment_Node, ntDocument_Node ], nil, false) do begin n:= NextNode; while assigned(n) do begin result.add(n); n:= NextNode; end; detach; end; contextNode.ownerDocument.clearInvalidNodeIterators; end; end; { TdomXPathAxisNameFollowing } function TdomXPathAxisNameFollowing.getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; var p,q: TdomNode; begin result:= TdomXPathSnapshotResult.create; result.axisType:= axisType; if assigned(contextNode) then begin case contextNode.nodeType of ntElement_Node,ntText_Node,ntCDATA_Section_Node,ntEntity_Reference_Node, ntProcessing_Instruction_Node,ntComment_Node: begin q:= contextNode; p:= contextNode.nextSibling; while assigned(p) do begin if not ( ( (q.nodeType = ntText_Node) or (q.nodeType = ntCDATA_Section_Node) or (q.nodeType = ntEntity_Reference_Node) ) and ( (p.nodeType = ntText_Node) or (p.nodeType = ntCDATA_Section_Node) or (p.nodeType = ntEntity_Reference_Node) ) ) then result.addSubtree(p); q:= p; p.nextSibling; end; end; end; end; end; { TdomXPathAxisNameFollowingSibling } function TdomXPathAxisNameFollowingSibling.getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; var p,q: TdomNode; begin result:= TdomXPathSnapshotResult.create; result.axisType:= axisType; if assigned(contextNode) then begin case contextNode.nodeType of ntElement_Node,ntText_Node,ntCDATA_Section_Node,ntEntity_Reference_Node, ntProcessing_Instruction_Node,ntComment_Node: begin q:= contextNode; p:= contextNode.nextSibling; while assigned(p) do begin if not ( ( (q.nodeType = ntText_Node) or (q.nodeType = ntCDATA_Section_Node) or (q.nodeType = ntEntity_Reference_Node) ) and ( (p.nodeType = ntText_Node) or (p.nodeType = ntCDATA_Section_Node) or (p.nodeType = ntEntity_Reference_Node) ) ) then result.add(p); q:= p; p.nextSibling; end; end; end; end; end; { TdomXPathAxisNameNamespace } constructor TdomXPathAxisNameNamespace.create(const avalue: wideString); begin inherited; FPrincipalNodeType:= ntXPath_Namespace_Node; end; function TdomXPathAxisNameNamespace.getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; begin raise ENot_Supported_Err.create('Not supported error.'); // xxx Add support for namespace nodes in a later version. end; { TdomXPathAxisNameParent } function TdomXPathAxisNameParent.getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; var n: TdomNode; begin result:= TdomXPathSnapshotResult.create; result.axisType:= axisType; if assigned(contextNode) then begin case contextNode.nodeType of ntElement_Node,ntText_Node,ntCDATA_Section_Node,ntEntity_Reference_Node, ntProcessing_Instruction_Node,ntComment_Node: n:= contextNode.parentNode; ntAttribute_Node: n:= TdomAttr(contextNode).ownerElement; ntXPath_Namespace_Node: n:= TdomXPathNamespace(contextNode).ownerElement; else n:= nil; end; if assigned(n) then result.add(n); end; end; { TdomXPathAxisNamePreceding } constructor TdomXPathAxisNamePreceding.create(const avalue: wideString); begin inherited; FAxisType:= XPATH_REVERSE_AXIS; end; function TdomXPathAxisNamePreceding.getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; var n: TdomNode; procedure addPreceding(const snapshot: TdomXPathSnapshotResult; const node: TdomNode); var p,q: TdomNode; begin case node.nodeType of ntElement_Node,ntText_Node,ntCDATA_Section_Node,ntEntity_Reference_Node, ntProcessing_Instruction_Node,ntComment_Node: begin p:= node.previousSibling; while assigned(p) do begin q:= p.previousSibling; if assigned(q) then begin if not ( ( (p.nodeType = ntText_Node) or (p.nodeType = ntCDATA_Section_Node) or (p.nodeType = ntEntity_Reference_Node) ) and ( (q.nodeType = ntText_Node) or (q.nodeType = ntCDATA_Section_Node) or (q.nodeType = ntEntity_Reference_Node) ) ) then snapshot.addSubtree(p); p:= q; end else begin snapshot.addSubtree(p); break; end; end; end; end; end; begin result:= TdomXPathSnapshotResult.create; result.axisType:= axisType; if assigned(contextNode) then begin addPreceding(result,contextNode); case contextNode.nodeType of ntElement_Node,ntText_Node,ntCDATA_Section_Node,ntEntity_Reference_Node, ntProcessing_Instruction_Node,ntComment_Node: n:= contextNode.parentNode; ntAttribute_Node: n:= TdomAttr(contextNode).ownerElement; ntXPath_Namespace_Node: n:= TdomXPathNamespace(contextNode).ownerElement; else n:= nil; end; while assigned(n) do begin addPreceding(result,n); n:= n.parentNode; end; end; end; { TdomXPathAxisNamePrecedingSibling } constructor TdomXPathAxisNamePrecedingSibling.create(const avalue: wideString); begin inherited; FAxisType:= XPATH_REVERSE_AXIS; end; function TdomXPathAxisNamePrecedingSibling.getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; var p,q: TdomNode; begin result:= TdomXPathSnapshotResult.create; result.axisType:= axisType; if assigned(contextNode) then begin case contextNode.nodeType of ntElement_Node,ntText_Node,ntCDATA_Section_Node,ntEntity_Reference_Node, ntProcessing_Instruction_Node,ntComment_Node: begin p:= contextNode.previousSibling; while assigned(p) do begin q:= p.previousSibling; if assigned(q) then begin if not ( ( (p.nodeType = ntText_Node) or (p.nodeType = ntCDATA_Section_Node) or (p.nodeType = ntEntity_Reference_Node) ) and ( (q.nodeType = ntText_Node) or (q.nodeType = ntCDATA_Section_Node) or (q.nodeType = ntEntity_Reference_Node) ) ) then result.add(p); p:= q; end else begin result.add(p); break; end; end; end; end; end; end; { TdomXPathAxisNameSelf } function TdomXPathAxisNameSelf.getAxisNodeSnapshot(const contextNode: TdomNode): TdomXPathSnapshotResult; begin result:= TdomXPathSnapshotResult.create; result.axisType:= axisType; if assigned(contextNode) then result.add(contextNode); end; { TdomXPathNodeTest } function TdomXPathNodeTest.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; begin if assigned(oldResult) then oldResult.Free; raise ENot_Supported_Err.create('Not supported error.'); // Remark: To evaluate a NodeTest the evaluate2 function must be used. end; function TdomXPathNodeTest.evaluate2(const oldSnapshotResult: TdomXPathSnapshotResult; const principalNodeType: TdomNodeType; const resolver: TdomXPathNSResolver): TdomXPathSnapshotResult; begin if not assigned(oldSnapshotResult) then raise EXPath_Type_Err.create('XPath type error.'); if left is TdomXPathNameTest then begin result:= TdomXPathNameTest(left).evaluate2(oldSnapshotResult,principalNodeType,resolver); end else if left is TdomXPathNodeTypeComment then begin result:= TdomXPathNodeTypeComment(left).evaluate2(oldSnapshotResult); end else if left is TdomXPathNodeTypeText then begin result:= TdomXPathNodeTypeText(left).evaluate2(oldSnapshotResult); end else if left is TdomXPathNodeTypePI then begin result:= TdomXPathNodeTypePI(left).evaluate2(oldSnapshotResult); end else if left is TdomXPathNodeTypeNode then begin result:= oldSnapshotResult; end else begin oldSnapshotResult.free; raise EXPath_Type_Err.create('XPath type error.'); end; end; { TdomXPathPredicate } function TdomXPathPredicate.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; begin if assigned(oldResult) then oldResult.Free; raise ENot_Supported_Err.create('Not supported error.'); // Remark: To evaluate a NodeTest the evaluate2 function must be used. end; function TdomXPathPredicate.evaluate2(const oldSnapshotResult: TdomXPathSnapshotResult; const resolver: TdomXPathNSResolver): TdomXPathSnapshotResult; var newContextNode: TdomNode; nextPredicateResult: TdomXPathSnapshotResult; predicateResult: TdomXPathResult; predicateResultAsBoolean: TdomXPathBooleanResult; contextPosition: integer; begin if not assigned(oldSnapshotResult) then raise EXPath_Type_Err.create('XPath type error.'); if not (left is TdomXPathExpr) then begin oldSnapshotResult.free; raise EXPath_Type_Err.create('XPath type error.'); end; try result:= TdomXPathSnapshotResult.create; result.axisType:= oldSnapshotResult.axisType; with oldSnapshotResult do begin for contextPosition:= 1 to snapshotLength do begin newContextNode:= snapshotitem(pred(contextPosition)); try predicateResult:= TdomXPathExpr(left).evaluate(newContextNode,nil,resolver); if predicateResult is TdomXPathNumberResult then begin if TdomXPathNumberResult(predicateResult).numberValue = contextPosition then result.add(newContextNode); predicateResult.free; end else begin predicateResultAsBoolean:= XPathBooleanFunc(predicateResult); if predicateResultAsBoolean.booleanValue then result.add(newContextNode); predicateResultAsBoolean.free; end; except result.free; raise; end; end; end; if assigned(right) then begin if right is TdomXPathPredicate then begin nextPredicateResult:= TdomXPathPredicate(right).evaluate2(result,resolver); result:= nextPredicateResult; end else begin result.free; raise EXPath_Type_Err.create('XPath type error.'); end; end; finally oldSnapshotResult.free; end; end; { TdomXPathFunctionCall } function TdomXPathFunctionCall.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; begin if assigned(oldResult) then oldResult.Free; raise ENot_Supported_Err.create('Not supported error.'); // xxx Support for function calls missing. end; { TdomXPathUnionExpr } function TdomXPathUnionExpr.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; var leftSnapshotResult: TdomXPathSnapshotResult; begin if assigned(oldResult) then oldResult.Free; if (left is TdomXPathUnionExpr) and (right is TdomXPathPathExpr) then begin leftSnapshotResult:= TdomXPathSnapshotResult(left.evaluate(contextNode,nil,resolver)); leftSnapshotResult.axisType:= XPATH_FORWARD_AXIS; try result:= right.evaluate(contextNode,nil,resolver); TdomXPathSnapshotResult(result).addSnapshotResult(leftSnapshotResult); finally leftSnapshotResult.free; end; end else begin result:= inherited evaluate(contextNode,nil,resolver); if result is TdomXPathSnapshotResult then TdomXPathSnapshotResult(result).axisType:= XPATH_FORWARD_AXIS; end; end; { TdomXPathPathExpr } function TdomXPathPathExpr.addStep(const step: TdomXPathStep): boolean; begin if not assigned(right) then begin right:= step; result:= true; end else begin if right is TdomXPathStep then result:= TdomXPathStep(right).addStep(step) else result:= false; end; end; function TdomXPathPathExpr.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; var newResult: TdomXPathResult; begin if assigned(oldResult) then oldResult.Free; if left is TdomXPathFilterExpr then begin // Filter expression plus optional relative location path: newResult:= TdomXPathFilterExpr(left).evaluate(contextNode,nil,resolver); if right is TdomXPathStep then begin if not (newResult is TdomXPathSnapshotResult) then begin newResult.free; raise EXPath_Type_Err.create('XPath type error.'); end; result:= TdomXPathStep(right).evaluate2(TdomXPathSnapshotResult(newResult),resolver); end else result:= newResult; end else if left is TdomXPathAbsoluteLocationPath then begin // Absolute location path: if not assigned(contextNode) then raise EXPath_Type_Err.create('XPath type error.'); if not assigned(contextNode.ownerDocument) then raise EXPath_Type_Err.create('XPath type error.'); newResult:= TdomXPathSnapshotResult.create; TdomXPathSnapshotResult(newResult).add(contextNode.ownerDocument); if right is TdomXPathStep then result:= TdomXPathStep(right).evaluate2(TdomXPathSnapshotResult(newResult),resolver) else result:= newResult; end else begin // Relative location path: if not (right is TdomXPathStep) then raise EXPath_Type_Err.create('XPath type error.'); if not assigned(contextNode) then raise EXPath_Type_Err.create('XPath type error.'); newResult:= TdomXPathSnapshotResult.create; TdomXPathSnapshotResult(newResult).add(contextNode); result:= TdomXPathStep(right).evaluate2(TdomXPathSnapshotResult(newResult),resolver) end; end; { TdomXPathFilterExpr } function TdomXPathFilterExpr.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; var newResult: TdomXPathResult; begin if assigned(oldResult) then oldResult.Free; if (left is TdomXPathFilterExpr) and (right is TdomXPathPredicate) then begin // Filter expression plus predicate: newResult:= TdomXPathFilterExpr(left).evaluate(contextNode,nil,resolver); if not (newResult is TdomXPathSnapshotResult) then begin newResult.free; raise EXPath_Type_Err.create('XPath type error.'); end; // A predicate filters the node-set with respect to the child axis, // so the axis always has to be a forward axis, no matter what axis // the previous expression required: if newResult is TdomXPathSnapshotResult then TdomXPathSnapshotResult(newResult).axisType:= XPATH_FORWARD_AXIS; result:= TdomXPathPredicate(right).evaluate2(TdomXPathSnapshotResult(newResult),resolver); end else if (left is TdomXPathPrimaryExpr) and not assigned(right) then begin // PrimaryExpr: result:= TdomXPathPrimaryExpr(left).evaluate(contextNode.ownerDocument.documentElement,nil,resolver); end else raise EXPath_Type_Err.create('XPath type error.'); end; { TdomXPathOrExpr } function TdomXPathOrExpr.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; var booleanResult: TdomXPathBooleanResult; begin if assigned(oldResult) then oldResult.Free; if (left is TdomXPathOrExpr) and (right is TdomXPathAndExpr) then begin booleanResult:= XPathBooleanFunc(left.evaluate(contextNode,nil,resolver)); if booleanResult.booleanValue then begin result:= booleanResult; end else begin booleanResult.free; result:= XPathBooleanFunc(right.evaluate(contextNode,nil,resolver)); end; end else result:= inherited evaluate(contextNode,oldResult,resolver); end; { TdomXPathAndExpr } function TdomXPathAndExpr.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; var booleanResult: TdomXPathBooleanResult; begin if assigned(oldResult) then oldResult.Free; if (left is TdomXPathOrExpr) and (right is TdomXPathAndExpr) then begin booleanResult:= XPathBooleanFunc(left.evaluate(contextNode,nil,resolver)); if not booleanResult.booleanValue then begin result:= booleanResult; end else begin booleanResult.free; result:= XPathBooleanFunc(right.evaluate(contextNode,nil,resolver)); end; end else result:= inherited evaluate(contextNode,oldResult,resolver); end; { TdomXPathIsEqualExpr } function TdomXPathIsEqualExpr.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; var leftResult,rightResult,swapResult: TdomXPathResult; stringResult: TdomXPathStringResult; leftBoolean,rightBoolean: TdomXPathBooleanResult; leftNumber,rightNumber: TdomXPathNumberResult; leftString,rightString: TdomXPathStringResult; leftResultString: wideString; i,j: integer; begin if assigned(oldResult) then oldResult.Free; result:= nil; if ( (left is TdomXPathIsEqualExpr) or (left is TdomXPathIsNotEqualExpr) ) and ( (right is TdomXPathLessThanExpr) or (right is TdomXPathLessThanOrEqualExpr) or (right is TdomXPathGreaterThanExpr) or (right is TdomXPathGreaterThanOrEqualExpr) ) then begin leftResult:= left.evaluate(contextNode,nil,resolver); try rightResult:= right.evaluate(contextNode,nil,resolver); try // Make sure, that if at least one set takes part in the comparision, // it is assigned to rightResult: if rightResult is TdomXPathSnapshotResult then begin swapResult:= leftResult; leftResult:= rightResult; rightResult:= swapResult; end; if leftResult is TdomXPathSnapshotResult then begin if rightResult is TdomXPathSnapshotResult then begin for i:= 0 to pred(TdomXPathSnapshotResult(leftResult).snapshotLength) do begin leftResultString:= TdomXPathSnapshotResult(leftResult).snapshotItem(i).XPathStringValue; for j:= 0 to pred(TdomXPathSnapshotResult(rightResult).snapshotLength) do begin if TdomXPathSnapshotResult(rightResult).snapshotItem(j).XPathStringValue = leftResultString then begin result:= TdomXPathBooleanResult.create(true); exit; end; end; end; result:= TdomXPathBooleanResult.create(false); exit; end else if (rightResult is TdomXPathNumberResult) or (rightResult is TdomXPathBooleanResult) or (rightResult is TdomXPathStringResult) then begin stringResult:= XPathStringFunc(rightResult); for i:= 0 to pred(TdomXPathSnapshotResult(leftResult).snapshotLength) do begin if TdomXPathSnapshotResult(leftResult).snapshotItem(i).XPathStringValue = stringResult.stringValue then begin result:= TdomXPathBooleanResult.create(true); rightResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end; end; result:= TdomXPathBooleanResult.create(false); rightResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end; end else if (leftResult is TdomXPathBooleanResult) or (rightResult is TdomXPathBooleanResult) then begin leftBoolean:= XPathBooleanFunc(leftResult); rightBoolean:= XPathBooleanFunc(rightResult); if leftBoolean.booleanValue = rightBoolean.booleanValue then result:= TdomXPathBooleanResult.create(true) else result:= TdomXPathBooleanResult.create(false); leftResult:= leftBoolean; // Re-assignment is required for correct rightResult:= rightBoolean; // freeing the TdomXPathResult below. end else if (leftResult is TdomXPathNumberResult) or (rightResult is TdomXPathNumberResult) then begin leftNumber:= XPathNumberFunc(leftResult); rightNumber:= XPathNumberFunc(rightResult); if leftNumber.numberValue = rightNumber.numberValue then result:= TdomXPathBooleanResult.create(true) else result:= TdomXPathBooleanResult.create(false); leftResult:= leftNumber; // Re-assignment is required for correct rightResult:= rightNumber; // freeing the TdomXPathResult below. end else begin leftString:= XPathStringFunc(leftResult); rightString:= XPathStringFunc(rightResult); if leftString.stringValue = rightString.stringValue then result:= TdomXPathBooleanResult.create(true) else result:= TdomXPathBooleanResult.create(false); leftResult:= leftString; // Re-assignment is required for correct rightResult:= rightString; // freeing the TdomXPathResult below. end; finally rightResult.free; end; finally leftResult.free; end; end else result:= inherited evaluate(contextNode,oldResult,resolver); end; { TdomXPathIsNotEqualExpr } function TdomXPathIsNotEqualExpr.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; var leftResult,rightResult,swapResult: TdomXPathResult; stringResult: TdomXPathStringResult; leftBoolean,rightBoolean: TdomXPathBooleanResult; leftNumber,rightNumber: TdomXPathNumberResult; leftString,rightString: TdomXPathStringResult; leftResultString: wideString; i,j: integer; begin if assigned(oldResult) then oldResult.Free; result:= nil; if ( (left is TdomXPathIsEqualExpr) or (left is TdomXPathIsNotEqualExpr) ) and ( (right is TdomXPathLessThanExpr) or (right is TdomXPathLessThanOrEqualExpr) or (right is TdomXPathGreaterThanExpr) or (right is TdomXPathGreaterThanOrEqualExpr) ) then begin leftResult:= left.evaluate(contextNode,nil,resolver); try rightResult:= right.evaluate(contextNode,nil,resolver); try // Make sure, that if at least one set takes part in the comparision, // it is assigned to rightResult: if rightResult is TdomXPathSnapshotResult then begin swapResult:= leftResult; leftResult:= rightResult; rightResult:= swapResult; end; if leftResult is TdomXPathSnapshotResult then begin if rightResult is TdomXPathSnapshotResult then begin for i:= 0 to pred(TdomXPathSnapshotResult(leftResult).snapshotLength) do begin leftResultString:= TdomXPathSnapshotResult(leftResult).snapshotItem(i).XPathStringValue; for j:= 0 to pred(TdomXPathSnapshotResult(rightResult).snapshotLength) do begin if TdomXPathSnapshotResult(rightResult).snapshotItem(j).XPathStringValue <> leftResultString then begin result:= TdomXPathBooleanResult.create(true); exit; end; end; end; result:= TdomXPathBooleanResult.create(false); exit; end else if (rightResult is TdomXPathNumberResult) or (rightResult is TdomXPathBooleanResult) or (rightResult is TdomXPathStringResult) then begin stringResult:= XPathStringFunc(rightResult); for i:= 0 to pred(TdomXPathSnapshotResult(leftResult).snapshotLength) do begin if TdomXPathSnapshotResult(leftResult).snapshotItem(i).XPathStringValue <> stringResult.stringValue then begin result:= TdomXPathBooleanResult.create(true); rightResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end; end; result:= TdomXPathBooleanResult.create(false); rightResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end; end else if (leftResult is TdomXPathBooleanResult) or (rightResult is TdomXPathBooleanResult) then begin leftBoolean:= XPathBooleanFunc(leftResult); rightBoolean:= XPathBooleanFunc(rightResult); if leftBoolean.booleanValue <> rightBoolean.booleanValue then result:= TdomXPathBooleanResult.create(true) else result:= TdomXPathBooleanResult.create(false); leftResult:= leftBoolean; // Re-assignment is required for correct rightResult:= rightBoolean; // freeing the TdomXPathResult below. end else if (leftResult is TdomXPathNumberResult) or (rightResult is TdomXPathNumberResult) then begin leftNumber:= XPathNumberFunc(leftResult); rightNumber:= XPathNumberFunc(rightResult); if leftNumber.numberValue <> rightNumber.numberValue then result:= TdomXPathBooleanResult.create(true) else result:= TdomXPathBooleanResult.create(false); leftResult:= leftNumber; // Re-assignment is required for correct rightResult:= rightNumber; // freeing the TdomXPathResult below. end else begin leftString:= XPathStringFunc(leftResult); rightString:= XPathStringFunc(rightResult); if leftString.stringValue <> rightString.stringValue then result:= TdomXPathBooleanResult.create(true) else result:= TdomXPathBooleanResult.create(false); leftResult:= leftString; // Re-assignment is required for correct rightResult:= rightString; // freeing the TdomXPathResult below. end; finally rightResult.free; end; finally leftResult.free; end; end else result:= inherited evaluate(contextNode,oldResult,resolver); end; { TdomXPathLessThanExpr } function TdomXPathLessThanExpr.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; var leftResult,rightResult: TdomXPathResult; stringResult: TdomXPathStringResult; leftNumber,rightNumber: TdomXPathNumberResult; leftResultString: wideString; i,j: integer; begin if assigned(oldResult) then oldResult.Free; if ( (left is TdomXPathLessThanExpr) or (left is TdomXPathLessThanOrEqualExpr) or (left is TdomXPathGreaterThanExpr) or (left is TdomXPathGreaterThanOrEqualExpr) ) and ( (right is TdomXPathPlusExpr) or (right is TdomXPathMinusExpr) ) then begin leftResult:= left.evaluate(contextNode,nil,resolver); try rightResult:= right.evaluate(contextNode,nil,resolver); try if (leftResult is TdomXPathSnapshotResult) and (rightResult is TdomXPathSnapshotResult) then begin for i:= 0 to pred(TdomXPathSnapshotResult(leftResult).snapshotLength) do begin leftResultString:= TdomXPathSnapshotResult(leftResult).snapshotItem(i).XPathStringValue; for j:= 0 to pred(TdomXPathSnapshotResult(rightResult).snapshotLength) do begin if TdomXPathSnapshotResult(rightResult).snapshotItem(j).XPathStringValue < leftResultString then begin result:= TdomXPathBooleanResult.create(true); exit; end; end; end; result:= TdomXPathBooleanResult.create(false); exit; end else if (leftResult is TdomXPathSnapshotResult) and ( (rightResult is TdomXPathNumberResult) or (rightResult is TdomXPathBooleanResult) or (rightResult is TdomXPathStringResult) ) then begin stringResult:= XPathStringFunc(rightResult); for i:= 0 to pred(TdomXPathSnapshotResult(leftResult).snapshotLength) do begin if TdomXPathSnapshotResult(leftResult).snapshotItem(i).XPathStringValue < stringResult.stringValue then begin result:= TdomXPathBooleanResult.create(true); rightResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end; end; result:= TdomXPathBooleanResult.create(false); rightResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end else if ( (leftResult is TdomXPathNumberResult) or (leftResult is TdomXPathBooleanResult) or (leftResult is TdomXPathStringResult) ) and (rightResult is TdomXPathSnapshotResult) then begin stringResult:= XPathStringFunc(leftResult); for i:= 0 to pred(TdomXPathSnapshotResult(rightResult).snapshotLength) do begin if stringResult.stringValue < TdomXPathSnapshotResult(rightResult).snapshotItem(i).XPathStringValue then begin result:= TdomXPathBooleanResult.create(true); leftResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end; end; result:= TdomXPathBooleanResult.create(false); leftResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end else begin leftNumber:= XPathNumberFunc(leftResult); rightNumber:= XPathNumberFunc(rightResult); if leftNumber.numberValue < rightNumber.numberValue then result:= TdomXPathBooleanResult.create(true) else result:= TdomXPathBooleanResult.create(false); leftResult:= leftNumber; // Re-assignment is required for correct rightResult:= rightNumber; // freeing the TdomXPathResult below. end; finally rightResult.free; end; finally leftResult.free; end; end else result:= inherited evaluate(contextNode,oldResult,resolver); end; { TdomXPathLessThanOrEqualExpr } function TdomXPathLessThanOrEqualExpr.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; var leftResult,rightResult: TdomXPathResult; stringResult: TdomXPathStringResult; leftNumber,rightNumber: TdomXPathNumberResult; leftResultString: wideString; i,j: integer; begin if assigned(oldResult) then oldResult.Free; if ( (left is TdomXPathLessThanExpr) or (left is TdomXPathLessThanOrEqualExpr) or (left is TdomXPathGreaterThanExpr) or (left is TdomXPathGreaterThanOrEqualExpr) ) and ( (right is TdomXPathPlusExpr) or (right is TdomXPathMinusExpr) ) then begin leftResult:= left.evaluate(contextNode,nil,resolver); try rightResult:= right.evaluate(contextNode,nil,resolver); try if (leftResult is TdomXPathSnapshotResult) and (rightResult is TdomXPathSnapshotResult) then begin for i:= 0 to pred(TdomXPathSnapshotResult(leftResult).snapshotLength) do begin leftResultString:= TdomXPathSnapshotResult(leftResult).snapshotItem(i).XPathStringValue; for j:= 0 to pred(TdomXPathSnapshotResult(rightResult).snapshotLength) do begin if TdomXPathSnapshotResult(rightResult).snapshotItem(j).XPathStringValue <= leftResultString then begin result:= TdomXPathBooleanResult.create(true); exit; end; end; end; result:= TdomXPathBooleanResult.create(false); exit; end else if (leftResult is TdomXPathSnapshotResult) and ( (rightResult is TdomXPathNumberResult) or (rightResult is TdomXPathBooleanResult) or (rightResult is TdomXPathStringResult) ) then begin stringResult:= XPathStringFunc(rightResult); for i:= 0 to pred(TdomXPathSnapshotResult(leftResult).snapshotLength) do begin if TdomXPathSnapshotResult(leftResult).snapshotItem(i).XPathStringValue <= stringResult.stringValue then begin result:= TdomXPathBooleanResult.create(true); rightResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end; end; result:= TdomXPathBooleanResult.create(false); rightResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end else if ( (leftResult is TdomXPathNumberResult) or (leftResult is TdomXPathBooleanResult) or (leftResult is TdomXPathStringResult) ) and (rightResult is TdomXPathSnapshotResult) then begin stringResult:= XPathStringFunc(leftResult); for i:= 0 to pred(TdomXPathSnapshotResult(rightResult).snapshotLength) do begin if stringResult.stringValue <= TdomXPathSnapshotResult(rightResult).snapshotItem(i).XPathStringValue then begin result:= TdomXPathBooleanResult.create(true); leftResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end; end; result:= TdomXPathBooleanResult.create(false); leftResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end else begin leftNumber:= XPathNumberFunc(leftResult); rightNumber:= XPathNumberFunc(rightResult); if leftNumber.numberValue <= rightNumber.numberValue then result:= TdomXPathBooleanResult.create(true) else result:= TdomXPathBooleanResult.create(false); leftResult:= leftNumber; // Re-assignment is required for correct rightResult:= rightNumber; // freeing the TdomXPathResult below. end; finally rightResult.free; end; finally leftResult.free; end; end else result:= inherited evaluate(contextNode,oldResult,resolver); end; { TdomXPathGreaterThanExpr } function TdomXPathGreaterThanExpr.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; var leftResult,rightResult: TdomXPathResult; stringResult: TdomXPathStringResult; leftNumber,rightNumber: TdomXPathNumberResult; leftResultString: wideString; i,j: integer; begin if assigned(oldResult) then oldResult.Free; if ( (left is TdomXPathLessThanExpr) or (left is TdomXPathLessThanOrEqualExpr) or (left is TdomXPathGreaterThanExpr) or (left is TdomXPathGreaterThanOrEqualExpr) ) and ( (right is TdomXPathPlusExpr) or (right is TdomXPathMinusExpr) ) then begin leftResult:= left.evaluate(contextNode,nil,resolver); try rightResult:= right.evaluate(contextNode,nil,resolver); try if (leftResult is TdomXPathSnapshotResult) and (rightResult is TdomXPathSnapshotResult) then begin for i:= 0 to pred(TdomXPathSnapshotResult(leftResult).snapshotLength) do begin leftResultString:= TdomXPathSnapshotResult(leftResult).snapshotItem(i).XPathStringValue; for j:= 0 to pred(TdomXPathSnapshotResult(rightResult).snapshotLength) do begin if TdomXPathSnapshotResult(rightResult).snapshotItem(j).XPathStringValue > leftResultString then begin result:= TdomXPathBooleanResult.create(true); exit; end; end; end; result:= TdomXPathBooleanResult.create(false); exit; end else if (leftResult is TdomXPathSnapshotResult) and ( (rightResult is TdomXPathNumberResult) or (rightResult is TdomXPathBooleanResult) or (rightResult is TdomXPathStringResult) ) then begin stringResult:= XPathStringFunc(rightResult); for i:= 0 to pred(TdomXPathSnapshotResult(leftResult).snapshotLength) do begin if TdomXPathSnapshotResult(leftResult).snapshotItem(i).XPathStringValue > stringResult.stringValue then begin result:= TdomXPathBooleanResult.create(true); rightResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end; end; result:= TdomXPathBooleanResult.create(false); rightResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end else if ( (leftResult is TdomXPathNumberResult) or (leftResult is TdomXPathBooleanResult) or (leftResult is TdomXPathStringResult) ) and (rightResult is TdomXPathSnapshotResult) then begin stringResult:= XPathStringFunc(leftResult); for i:= 0 to pred(TdomXPathSnapshotResult(rightResult).snapshotLength) do begin if stringResult.stringValue > TdomXPathSnapshotResult(rightResult).snapshotItem(i).XPathStringValue then begin result:= TdomXPathBooleanResult.create(true); leftResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end; end; result:= TdomXPathBooleanResult.create(false); leftResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end else begin leftNumber:= XPathNumberFunc(leftResult); rightNumber:= XPathNumberFunc(rightResult); if leftNumber.numberValue > rightNumber.numberValue then result:= TdomXPathBooleanResult.create(true) else result:= TdomXPathBooleanResult.create(false); leftResult:= leftNumber; // Re-assignment is required for correct rightResult:= rightNumber; // freeing the TdomXPathResult below. end; finally rightResult.free; end; finally leftResult.free; end; end else result:= inherited evaluate(contextNode,oldResult,resolver); end; { TdomXPathGreaterThanOrEqualExpr } function TdomXPathGreaterThanOrEqualExpr.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; var leftResult,rightResult: TdomXPathResult; stringResult: TdomXPathStringResult; leftNumber,rightNumber: TdomXPathNumberResult; leftResultString: wideString; i,j: integer; begin if assigned(oldResult) then oldResult.Free; if ( (left is TdomXPathLessThanExpr) or (left is TdomXPathLessThanOrEqualExpr) or (left is TdomXPathGreaterThanExpr) or (left is TdomXPathGreaterThanOrEqualExpr) ) and ( (right is TdomXPathPlusExpr) or (right is TdomXPathMinusExpr) ) then begin leftResult:= left.evaluate(contextNode,nil,resolver); try rightResult:= right.evaluate(contextNode,nil,resolver); try if (leftResult is TdomXPathSnapshotResult) and (rightResult is TdomXPathSnapshotResult) then begin for i:= 0 to pred(TdomXPathSnapshotResult(leftResult).snapshotLength) do begin leftResultString:= TdomXPathSnapshotResult(leftResult).snapshotItem(i).XPathStringValue; for j:= 0 to pred(TdomXPathSnapshotResult(rightResult).snapshotLength) do begin if TdomXPathSnapshotResult(rightResult).snapshotItem(j).XPathStringValue >= leftResultString then begin result:= TdomXPathBooleanResult.create(true); exit; end; end; end; result:= TdomXPathBooleanResult.create(false); exit; end else if (leftResult is TdomXPathSnapshotResult) and ( (rightResult is TdomXPathNumberResult) or (rightResult is TdomXPathBooleanResult) or (rightResult is TdomXPathStringResult) ) then begin stringResult:= XPathStringFunc(rightResult); for i:= 0 to pred(TdomXPathSnapshotResult(leftResult).snapshotLength) do begin if TdomXPathSnapshotResult(leftResult).snapshotItem(i).XPathStringValue >= stringResult.stringValue then begin result:= TdomXPathBooleanResult.create(true); rightResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end; end; result:= TdomXPathBooleanResult.create(false); rightResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end else if ( (leftResult is TdomXPathNumberResult) or (leftResult is TdomXPathBooleanResult) or (leftResult is TdomXPathStringResult) ) and (rightResult is TdomXPathSnapshotResult) then begin stringResult:= XPathStringFunc(leftResult); for i:= 0 to pred(TdomXPathSnapshotResult(rightResult).snapshotLength) do begin if stringResult.stringValue >= TdomXPathSnapshotResult(rightResult).snapshotItem(i).XPathStringValue then begin result:= TdomXPathBooleanResult.create(true); leftResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end; end; result:= TdomXPathBooleanResult.create(false); leftResult:= stringResult; // Re-assignment is required for correct freeing the TdomXPathResult below. exit; end else begin leftNumber:= XPathNumberFunc(leftResult); rightNumber:= XPathNumberFunc(rightResult); if leftNumber.numberValue >= rightNumber.numberValue then result:= TdomXPathBooleanResult.create(true) else result:= TdomXPathBooleanResult.create(false); leftResult:= leftNumber; // Re-assignment is required for correct rightResult:= rightNumber; // freeing the TdomXPathResult below. end; finally rightResult.free; end; finally leftResult.free; end; end else result:= inherited evaluate(contextNode,oldResult,resolver); end; { TdomXPathPlusExpr } function TdomXPathPlusExpr.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; var leftNumber,rightNumber: TdomXPathNumberResult; begin if assigned(oldResult) then oldResult.Free; if ( (left is TdomXPathPlusExpr) or (left is TdomXPathMinusExpr) ) and ( (right is TdomXPathMultiplyExpr) or (right is TdomXPathDivExpr) or (right is TdomXPathModExpr) ) then begin leftNumber:= XPathNumberFunc(left.evaluate(contextNode,nil,resolver)); try rightNumber:= XPathNumberFunc(right.evaluate(contextNode,nil,resolver)); try result:= TdomXPathNumberResult.create(leftNumber.numberValue + rightNumber.numberValue); finally rightNumber.Free; end; finally leftNumber.free; end; end else result:= inherited evaluate(contextNode,oldResult,resolver); end; { TdomXPathMinusExpr } function TdomXPathMinusExpr.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; var leftNumber,rightNumber: TdomXPathNumberResult; begin if assigned(oldResult) then oldResult.Free; if ( (left is TdomXPathPlusExpr) or (left is TdomXPathMinusExpr) ) and ( (right is TdomXPathMultiplyExpr) or (right is TdomXPathDivExpr) or (right is TdomXPathModExpr) ) then begin leftNumber:= XPathNumberFunc(left.evaluate(contextNode,nil,resolver)); try rightNumber:= XPathNumberFunc(right.evaluate(contextNode,nil,resolver)); try result:= TdomXPathNumberResult.create(leftNumber.numberValue - rightNumber.numberValue); finally rightNumber.Free; end; finally leftNumber.free; end; end else result:= inherited evaluate(contextNode,oldResult,resolver); end; { TdomXPathMultiplyExpr } function TdomXPathMultiplyExpr.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; var leftNumber,rightNumber: TdomXPathNumberResult; begin if assigned(oldResult) then oldResult.Free; if ( (left is TdomXPathMultiplyExpr) or (left is TdomXPathDivExpr) or (left is TdomXPathModExpr) ) and (right is TdomXPathUnaryExpr) then begin leftNumber:= XPathNumberFunc(left.evaluate(contextNode,nil,resolver)); try rightNumber:= XPathNumberFunc(right.evaluate(contextNode,nil,resolver)); try result:= TdomXPathNumberResult.create(leftNumber.numberValue * rightNumber.numberValue); finally rightNumber.Free; end; finally leftNumber.free; end; end else result:= inherited evaluate(contextNode,oldResult,resolver); end; { TdomXPathDivExpr } function TdomXPathDivExpr.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; var leftNumber,rightNumber: TdomXPathNumberResult; begin result:= nil; // Necessary to avoid compiler warning "Return value ... might be undefined." if assigned(oldResult) then oldResult.Free; if ( (left is TdomXPathMultiplyExpr) or (left is TdomXPathDivExpr) or (left is TdomXPathModExpr) ) and (right is TdomXPathUnaryExpr) then begin leftNumber:= XPathNumberFunc(left.evaluate(contextNode,nil,resolver)); try rightNumber:= XPathNumberFunc(right.evaluate(contextNode,nil,resolver)); try if rightNumber.numberValue = 0 then raise EXPath_Type_Err.create('XPath type error.'); // xxx Replace this by NaN !!!!!! result:= TdomXPathNumberResult.create(leftNumber.numberValue / rightNumber.numberValue); finally rightNumber.Free; end; finally leftNumber.free; end; end else result:= inherited evaluate(contextNode,oldResult,resolver); end; { TdomXPathModExpr } function TdomXPathModExpr.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; var leftNumber,rightNumber: TdomXPathNumberResult; begin result:= nil; // Necessary to avoid compiler warning "Return value ... might be undefined." if assigned(oldResult) then oldResult.Free; if ( (left is TdomXPathMultiplyExpr) or (left is TdomXPathDivExpr) or (left is TdomXPathModExpr) ) and (right is TdomXPathUnaryExpr) then begin leftNumber:= XPathNumberFunc(left.evaluate(contextNode,nil,resolver)); try rightNumber:= XPathNumberFunc(right.evaluate(contextNode,nil,resolver)); try if rightNumber.numberValue = 0 then raise EXPath_Type_Err.create('XPath type error.'); // xxx Replace this by NaN !!!!!! result:= TdomXPathNumberResult.create(leftNumber.numberValue - trunc(leftNumber.numberValue / rightNumber.numberValue) * rightNumber.numberValue); finally rightNumber.Free; end; finally leftNumber.free; end; end else result:= inherited evaluate(contextNode,oldResult,resolver); end; { TdomXPathUnaryExpr } function TdomXPathUnaryExpr.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; var Number: TdomXPathNumberResult; begin if assigned(oldResult) then oldResult.Free; if (left is TdomXPathMultiplyOperator) and (right is TdomXPathUnaryExpr) then begin Number:= XPathNumberFunc(left.evaluate(contextNode,nil,resolver)); try result:= TdomXPathNumberResult.create(-(Number.numberValue)) // xxx Negative 0 as required by IEEE 754 is not supported here. finally Number.Free; end; end else result:= inherited evaluate(contextNode,oldResult,resolver); end; { TdomXPathLiteral } function TdomXPathLiteral.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; begin if assigned(oldResult) then oldResult.Free; result:= TdomXPathStringResult.create(value); end; { TdomXPathNumber } function TdomXPathNumber.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; begin if assigned(oldResult) then oldResult.Free; result:= TdomXPathNumberResult.create(StrToFloat(value)); end; { TdomXPathVariableReference } function TdomXPathVariableReference.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; begin if assigned(oldResult) then oldResult.Free; raise ENot_Supported_Err.create('Not supported error.'); // xxx Add support for variable references in a later version. end; { TdomXPathNameTest } constructor TdomXPathNameTest.create(const avalue: wideString); begin inherited; if avalue = '*' then begin FPrefix:= ''; FLocalName:= '*'; end else if value[length(avalue)] = '*' then begin FPrefix:= copy(avalue,1,length(avalue)-2); FLocalName:= '*'; end else begin FPrefix:= xmlExtractPrefix(avalue); FLocalName:= xmlExtractLocalName(avalue); end; end; function TdomXPathNameTest.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; begin if assigned(oldResult) then oldResult.Free; raise ENot_Supported_Err.create('Not supported error.'); // Remark: To evaluate a NameTest the evaluate2 function must be used. end; function TdomXPathNameTest.evaluate2(const oldSnapshotResult: TdomXPathSnapshotResult; const principalNodeType: TdomNodeType; const resolver: TdomXPathNSResolver): TdomXPathSnapshotResult; var valueNamespaceUri: wideString; i: integer; begin if not assigned(oldSnapshotResult) then raise EXPath_Type_Err.create('XPath type error.'); if FPrefix <> '' then begin if FPrefix = 'xmlns' then begin valueNamespaceUri:= 'http://www.w3.org/2000/xmlns/'; end else if FPrefix = 'xml' then begin valueNamespaceUri:= 'http://www.w3.org/XML/1998/namespace'; end else begin if not assigned(resolver) then begin oldSnapshotResult.free; raise ENamespace_Err.Create('Namespace resolver not specified.'); end; valueNamespaceUri:= resolver.lookupNamespaceURI(FPrefix); if valueNamespaceUri = '' then begin oldSnapshotResult.free; raise ENamespace_Err.CreateFmt('Namespace URI of prefix ''%S'' not found.',[FPrefix]); end; end; end else valueNamespaceUri:= ''; with oldSnapshotResult do begin i:= pred(snapshotLength); while i >= 0 do begin if snapshotItem(i).nodeType <> principalNodeType then begin delete(i); end else if value <> '*' then begin if FLocalName = '*' then begin if snapshotItem(i).prefix <> FPrefix then delete(i); end else begin if (snapshotItem(i).prefix <> FPrefix) or (snapshotItem(i).localName <> FLocalName) then delete(i); end; end; dec(i); end; end; result:= oldSnapshotResult; end; { TdomXPathNodeTypeComment } function TdomXPathNodeTypeComment.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; begin if assigned(oldResult) then oldResult.Free; raise ENot_Supported_Err.create('Not supported error.'); // Remark: To evaluate a Comment the evaluate2 function must be used. end; function TdomXPathNodeTypeComment.evaluate2(const oldSnapshotResult: TdomXPathSnapshotResult): TdomXPathSnapshotResult; var i: integer; begin if not assigned(oldSnapshotResult) then raise EXPath_Type_Err.create('XPath type error.'); with oldSnapshotResult do begin i:= pred(snapshotLength); while i >= 0 do begin if snapshotItem(i).nodeType <> ntComment_Node then delete(i); dec(i); end; end; result:= oldSnapshotResult; end; { TdomXPathNodeTypePI } function TdomXPathNodeTypePI.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; begin if assigned(oldResult) then oldResult.Free; raise ENot_Supported_Err.create('Not supported error.'); // Remark: To evaluate a PI the evaluate2 function must be used. end; function TdomXPathNodeTypePI.evaluate2(const oldSnapshotResult: TdomXPathSnapshotResult): TdomXPathSnapshotResult; var i: integer; begin if not assigned(oldSnapshotResult) then raise EXPath_Type_Err.create('XPath type error.'); if assigned(left) then begin if left is TdomXPathLiteral then begin with oldSnapshotResult do begin i:= pred(snapshotLength); while i >= 0 do begin with snapshotItem(i) do if (nodeType <> ntProcessing_Instruction_Node) or (nodeValue <> TdomXPathLiteral(left).value) then delete(i); dec(i); end; end; end else begin oldSnapshotResult.free; raise EXPath_Type_Err.create('XPath type error.'); end; end else begin with oldSnapshotResult do begin i:= pred(snapshotLength); while i >= 0 do begin if snapshotItem(i).nodeType <> ntProcessing_Instruction_Node then delete(i); dec(i); end; end; end; result:= oldSnapshotResult; end; { TdomXPathNodeTypeText } function TdomXPathNodeTypeText.evaluate(const contextNode: TdomNode; const oldResult: TdomXPathResult; const resolver: TdomXPathNSResolver): TdomXPathResult; begin if assigned(oldResult) then oldResult.Free; raise ENot_Supported_Err.create('Not supported error.'); // Remark: To evaluate a Text the evaluate2 function must be used. end; function TdomXPathNodeTypeText.evaluate2(const oldSnapshotResult: TdomXPathSnapshotResult): TdomXPathSnapshotResult; var i: integer; begin if not assigned(oldSnapshotResult) then raise EXPath_Type_Err.create('XPath type error.'); with oldSnapshotResult do begin i:= pred(snapshotLength); while i >= 0 do begin if not (snapshotItem(i).nodeType in [ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node] ) then delete(i); dec(i); end; end; result:= oldSnapshotResult; end; { TdomXPathTokenizer } constructor TdomXPathTokenizer.create(const expression: wideString; const xpathVersion: wideString); begin if xpathVersion <> '1.0' then raise ENot_Supported_Err.CreateFmt('XPath version "%S" not supproted.',[xpathVersion]); FExpression:= expression; FLastSymbol:= XPATH_INVALID_TOKEN; // Use XPATH_INVALID_TOKEN as a dummy value FPosition:= 0; FDoubleSlashStatus:= SL_NO_DOUBLE_SLASH; FPositionCache:= 0; FSymbolCache:= XPATH_INVALID_TOKEN; FValueCache:= ''; FCacheIsActive:= false; end; function TdomXPathTokenizer.doubleColonFollows: boolean; var i: integer; begin result:= false; for i:= FPosition+1 to pred(length(FExpression)) do begin if FExpression[i] = #$3a then begin if FExpression[i+1] = #$3a then result:= true; exit; end; if not isXmlWhiteSpace(FExpression[i]) then exit; end; end; function TdomXPathTokenizer.getNextWideChar(out s: wideChar): boolean; begin if FPosition = length(FExpression) then begin s:= #0; result:= false; end else begin inc(FPosition); s:= FExpression[FPosition]; result:= true; end; end; function TdomXPathTokenizer.isFollowing(const symbol: TdomXPathTokenType): boolean; begin if not FCacheIsActive then begin read(FSymbolCache,FValueCache,FPositionCache); FCacheIsActive:= true; end; if FSymbolCache = symbol then result:= true else result:= false; end; function TdomXPathTokenizer.leftParanthesisFollows: boolean; var i: integer; begin result:= false; for i:= FPosition+1 to length(FExpression) do begin if FExpression[i] = #$28 then begin result:= true; exit; end; if not isXmlWhiteSpace(FExpression[i]) then exit; end; end; function TdomXPathTokenizer.lookAheadNextWideChar(out s: wideChar): boolean; begin if FPosition = length(FExpression) then begin s:= #0; result:= false; end else begin s:= FExpression[FPosition+1]; result:= true; end; end; procedure TdomXPathTokenizer.read(out symbol: TdomXPathTokenType; out value: wideString; out position: integer); var S: WideChar; L: WideChar; DecimalPointFound: boolean; begin if FCacheIsActive then begin symbol:= FSymbolCache; value:= FValueCache; position:= FPositionCache; FCacheIsActive:= false; exit; end; case FDoubleSlashStatus of SL_NO_DOUBLE_SLASH: begin repeat if not getNextWideChar(S) then begin // End of text: symbol:= XPATH_END_OF_TEXT_TOKEN; value:= ''; position:= -1; exit; end; until not isXmlWhiteSpace(S); case ord(S) of $28: begin // '(' symbol:= XPATH_LEFT_PARENTHESIS_TOKEN; FLastSymbol:= XPATH_LEFT_PARENTHESIS_TOKEN; value:= ''; position:= FPosition; end; $29: begin // ')' symbol:= XPATH_RIGHT_PARENTHESIS_TOKEN; FLastSymbol:= XPATH_RIGHT_PARENTHESIS_TOKEN; value:= ''; position:= FPosition; end; $5b: begin // '[' symbol:= XPATH_LEFT_SQUARE_BRACKET_TOKEN; FLastSymbol:= XPATH_LEFT_SQUARE_BRACKET_TOKEN; value:= ''; position:= FPosition; end; $5d: begin // ']' symbol:= XPATH_RIGHT_SQUARE_BRACKET_TOKEN; FLastSymbol:= XPATH_RIGHT_SQUARE_BRACKET_TOKEN; value:= ''; position:= FPosition; end; $40: begin // '@' symbol:= XPATH_COMMERCIAL_AT_TOKEN; FLastSymbol:= XPATH_COMMERCIAL_AT_TOKEN; value:= ''; position:= FPosition; end; $2c: begin // ',' symbol:= XPATH_COMMA_TOKEN; FLastSymbol:= XPATH_COMMA_TOKEN; value:= ''; position:= FPosition; end; $3a: begin // ':' lookAheadNextWideChar(L); if L = #$3a then begin // '::' inc(FPosition); symbol:= XPATH_DOUBLE_COLON_TOKEN; FLastSymbol:= XPATH_DOUBLE_COLON_TOKEN; value:= ''; position:= FPosition; end else begin symbol:= XPATH_INVALID_TOKEN; FLastSymbol:= XPATH_INVALID_TOKEN; value:= ':'; position:= FPosition; end; end; $7c: begin // '|' symbol:= XPATH_SHEFFER_STROKE_OPERATOR_TOKEN; FLastSymbol:= XPATH_SHEFFER_STROKE_OPERATOR_TOKEN; value:= ''; position:= FPosition; end; $2b: begin // '+' symbol:= XPATH_PLUS_OPERATOR_TOKEN; FLastSymbol:= XPATH_PLUS_OPERATOR_TOKEN; value:= ''; position:= FPosition; end; $2d: begin // '-' symbol:= XPATH_MINUS_OPERATOR_TOKEN; FLastSymbol:= XPATH_MINUS_OPERATOR_TOKEN; value:= ''; position:= FPosition; end; $3d: begin // '=' symbol:= XPATH_IS_EQUAL_OPERATOR_TOKEN; FLastSymbol:= XPATH_IS_EQUAL_OPERATOR_TOKEN; value:= ''; position:= FPosition; end; $21: begin // '!' lookAheadNextWideChar(L); if L = #$3d then begin // '!=' inc(FPosition); symbol:= XPATH_IS_NOT_EQUAL_OPERATOR_TOKEN; FLastSymbol:= XPATH_IS_NOT_EQUAL_OPERATOR_TOKEN; value:= ''; position:= FPosition; end else begin symbol:= XPATH_INVALID_TOKEN; FLastSymbol:= XPATH_INVALID_TOKEN; value:= '!'; position:= FPosition; end; end; $2f: begin // '/' lookAheadNextWideChar(L); if L = #$2f then begin // '//' inc(FPosition); FDoubleSlashStatus:= SL_XPATH_AXIS_NAME_DESCENDANT_OR_SELF_TOKEN_FOLLOWS; end; symbol:= XPATH_SLASH_OPERATOR_TOKEN; FLastSymbol:= XPATH_SLASH_OPERATOR_TOKEN; value:= ''; position:= FPosition; end; $3c: begin // '<' lookAheadNextWideChar(L); if L = #$3d then begin // '<=' inc(FPosition); symbol:= XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN; FLastSymbol:= XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN; end else begin symbol:= XPATH_LESS_THAN_OPERATOR_TOKEN; FLastSymbol:= XPATH_LESS_THAN_OPERATOR_TOKEN; end; value:= ''; position:= FPosition; end; $3e: begin // '>' lookAheadNextWideChar(L); if L = #$3d then begin // '>=' inc(FPosition); symbol:= XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN; FLastSymbol:= XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN; end else begin symbol:= XPATH_GREATER_THAN_OPERATOR_TOKEN; FLastSymbol:= XPATH_GREATER_THAN_OPERATOR_TOKEN; end; value:= ''; position:= FPosition; end; $2e: begin // '.' lookAheadNextWideChar(L); case ord(L) of $2e: begin // '..' inc(FPosition); symbol:= XPATH_DOUBLE_DOT_TOKEN; FLastSymbol:= XPATH_DOUBLE_DOT_TOKEN; value:= ''; position:= FPosition; end; $30..$39: begin // Digit value:= '.'; repeat inc(FPosition); value:= concat(value,wideString(L)); lookAheadNextWideChar(L); until not (ord(L) in [$30..$39]); symbol:= XPATH_NUMBER_TOKEN; FLastSymbol:= XPATH_NUMBER_TOKEN; position:= FPosition; end; else // '.' symbol:= XPATH_SINGLE_DOT_TOKEN; FLastSymbol:= XPATH_SINGLE_DOT_TOKEN; value:= ''; position:= FPosition; end; {case ... else} end; $30..$39: begin // Digit value:= S; DecimalPointFound:= false; if lookAheadNextWideChar(S) then begin while (ord(S) in [$30..$39]) or ((S = #$2e) and not DecimalPointFound) do begin inc(FPosition); value:= concat(value,wideString(S)); if S = #$2e then DecimalPointFound:= true; lookAheadNextWideChar(S); end; end; symbol:= XPATH_NUMBER_TOKEN; FLastSymbol:= XPATH_NUMBER_TOKEN; position:= FPosition; end; $22: begin // '"' value:= ''; if not getNextWideChar(S) then begin symbol:= XPATH_INVALID_TOKEN; FLastSymbol:= XPATH_INVALID_TOKEN; position:= FPosition; exit; end; while S <> #$22 do begin value:= concat(value,wideString(S)); if not getNextWideChar(S) then begin symbol:= XPATH_INVALID_TOKEN; FLastSymbol:= XPATH_INVALID_TOKEN; position:= FPosition; exit; end; end; symbol:= XPATH_LITERAL_TOKEN; FLastSymbol:= XPATH_LITERAL_TOKEN; position:= FPosition; end; $27: begin // '"' value:= ''; if not getNextWideChar(S) then begin symbol:= XPATH_INVALID_TOKEN; FLastSymbol:= XPATH_INVALID_TOKEN; position:= FPosition; exit; end; while S <> #$27 do begin value:= concat(value,wideString(S)); if not getNextWideChar(S) then begin symbol:= XPATH_INVALID_TOKEN; FLastSymbol:= XPATH_INVALID_TOKEN; position:= FPosition; exit; end; end; symbol:= XPATH_LITERAL_TOKEN; FLastSymbol:= XPATH_LITERAL_TOKEN; position:= FPosition; end; $24: begin // '$' if not lookAheadNextWideChar(S) then begin symbol:= XPATH_INVALID_TOKEN; FLastSymbol:= XPATH_INVALID_TOKEN; position:= FPosition; exit; end; if not ( IsXmlLetter(S) or ( S = #$5f ) ) then begin // Letter or '_'? symbol:= XPATH_INVALID_TOKEN; FLastSymbol:= XPATH_INVALID_TOKEN; position:= FPosition; value:= wideString(S); exit; end; value:= ''; while IsXmlNCNameChar(S) do begin inc(FPosition); value:= concat(value,wideString(S)); if not lookAheadNextWideChar(S) then break; end; if S = #$3a then begin // ':' ? inc(FPosition); if not lookAheadNextWideChar(S) then begin symbol:= XPATH_INVALID_TOKEN; FLastSymbol:= XPATH_INVALID_TOKEN; position:= FPosition; value:= concat(value,':'); exit; end; if S = #$3a then begin // '::' ? dec(FPosition); end else begin value:= concat(value,':'); if not ( IsXmlLetter(S) or ( S = #$5f ) ) then begin // Letter or '_'? symbol:= XPATH_INVALID_TOKEN; FLastSymbol:= XPATH_INVALID_TOKEN; position:= FPosition; value:= concat(value,wideString(S)); exit; end; while IsXmlNCNameChar(S) do begin inc(FPosition); value:= concat(value,wideString(S)); if not self.lookAheadNextWideChar(S) then break; end; end; end; symbol:= XPATH_VARIABLE_REFERENCE_TOKEN; FLastSymbol:= XPATH_VARIABLE_REFERENCE_TOKEN; position:= FPosition; end; $2a: begin // '*' if FLastSymbol in [ XPATH_LEFT_PARENTHESIS_TOKEN, XPATH_LEFT_SQUARE_BRACKET_TOKEN, XPATH_COMMERCIAL_AT_TOKEN, XPATH_COMMA_TOKEN, XPATH_DOUBLE_COLON_TOKEN, XPATH_AND_OPERATOR_TOKEN, XPATH_OR_OPERATOR_TOKEN, XPATH_MOD_OPERATOR_TOKEN, XPATH_DIV_OPERATOR_TOKEN, XPATH_MULTIPLY_OPERATOR_TOKEN, XPATH_SLASH_OPERATOR_TOKEN, XPATH_SHEFFER_STROKE_OPERATOR_TOKEN, XPATH_PLUS_OPERATOR_TOKEN, XPATH_MINUS_OPERATOR_TOKEN, XPATH_IS_EQUAL_OPERATOR_TOKEN, XPATH_IS_NOT_EQUAL_OPERATOR_TOKEN, XPATH_LESS_THAN_OPERATOR_TOKEN, XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN, XPATH_GREATER_THAN_OPERATOR_TOKEN, XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN, XPATH_INVALID_TOKEN // = no preceding token ] then begin symbol:= XPATH_NAME_TEST_TOKEN; FLastSymbol:= XPATH_NAME_TEST_TOKEN; value:= '*'; end else begin symbol:= XPATH_MULTIPLY_OPERATOR_TOKEN; FLastSymbol:= XPATH_MULTIPLY_OPERATOR_TOKEN; value:= ''; end; position:= FPosition; end; else {case ...} // Parse NCName: if not ( IsXmlLetter(S) or ( S = #$5f ) ) then begin // Letter or '_'? symbol:= XPATH_INVALID_TOKEN; FLastSymbol:= XPATH_INVALID_TOKEN; position:= FPosition; value:= wideString(S); exit; end; value:= ''; dec(FPosition); while IsXmlNCNameChar(S) do begin inc(FPosition); value:= concat(value,wideString(S)); if not lookAheadNextWideChar(S) then break; end; if not ( FLastSymbol in [ XPATH_LEFT_PARENTHESIS_TOKEN, XPATH_LEFT_SQUARE_BRACKET_TOKEN, XPATH_COMMERCIAL_AT_TOKEN, XPATH_COMMA_TOKEN, XPATH_DOUBLE_COLON_TOKEN, XPATH_AND_OPERATOR_TOKEN, XPATH_OR_OPERATOR_TOKEN, XPATH_MOD_OPERATOR_TOKEN, XPATH_DIV_OPERATOR_TOKEN, XPATH_MULTIPLY_OPERATOR_TOKEN, XPATH_SLASH_OPERATOR_TOKEN, XPATH_SHEFFER_STROKE_OPERATOR_TOKEN, XPATH_PLUS_OPERATOR_TOKEN, XPATH_MINUS_OPERATOR_TOKEN, XPATH_IS_EQUAL_OPERATOR_TOKEN, XPATH_IS_NOT_EQUAL_OPERATOR_TOKEN, XPATH_LESS_THAN_OPERATOR_TOKEN, XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN, XPATH_GREATER_THAN_OPERATOR_TOKEN, XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN, XPATH_INVALID_TOKEN // = no preceding token ] ) then begin if value = 'and' then begin symbol:= XPATH_AND_OPERATOR_TOKEN; FLastSymbol:= XPATH_AND_OPERATOR_TOKEN; value:= ''; end else if value = 'or' then begin symbol:= XPATH_OR_OPERATOR_TOKEN; FLastSymbol:= XPATH_OR_OPERATOR_TOKEN; value:= ''; end else if value = 'mod' then begin symbol:= XPATH_MOD_OPERATOR_TOKEN; FLastSymbol:= XPATH_MOD_OPERATOR_TOKEN; value:= ''; end else if value = 'div' then begin symbol:= XPATH_DIV_OPERATOR_TOKEN; FLastSymbol:= XPATH_DIV_OPERATOR_TOKEN; value:= ''; end else begin symbol:= XPATH_INVALID_TOKEN; FLastSymbol:= XPATH_INVALID_TOKEN; end; position:= FPosition; exit; end; if doubleColonFollows then begin if value = 'ancestor' then begin symbol:= XPATH_AXIS_NAME_ANCESTOR_TOKEN; FLastSymbol:= XPATH_AXIS_NAME_ANCESTOR_TOKEN; value:= ''; end else if value = 'ancestor-or-self' then begin symbol:= XPATH_AXIS_NAME_ANCESTOR_OR_SELF_TOKEN; FLastSymbol:= XPATH_AXIS_NAME_ANCESTOR_OR_SELF_TOKEN; value:= ''; end else if value = 'attribute' then begin symbol:= XPATH_AXIS_NAME_ATTRIBUTE_TOKEN; FLastSymbol:= XPATH_AXIS_NAME_ATTRIBUTE_TOKEN; value:= ''; end else if value = 'child' then begin symbol:= XPATH_AXIS_NAME_CHILD_TOKEN; FLastSymbol:= XPATH_AXIS_NAME_CHILD_TOKEN; value:= ''; end else if value = 'descendant' then begin symbol:= XPATH_AXIS_NAME_DESCENDANT_TOKEN; FLastSymbol:= XPATH_AXIS_NAME_DESCENDANT_TOKEN; value:= ''; end else if value = 'descendant-or-self' then begin symbol:= XPATH_AXIS_NAME_DESCENDANT_OR_SELF_TOKEN; FLastSymbol:= XPATH_AXIS_NAME_DESCENDANT_OR_SELF_TOKEN; value:= ''; end else if value = 'following' then begin symbol:= XPATH_AXIS_NAME_FOLLOWING_TOKEN; FLastSymbol:= XPATH_AXIS_NAME_FOLLOWING_TOKEN; value:= ''; end else if value = 'following-sibling' then begin symbol:= XPATH_AXIS_NAME_FOLLOWING_SIBLING_TOKEN; FLastSymbol:= XPATH_AXIS_NAME_FOLLOWING_SIBLING_TOKEN; value:= ''; end else if value = 'namespace' then begin symbol:= XPATH_AXIS_NAME_NAMESPACE_TOKEN; FLastSymbol:= XPATH_AXIS_NAME_NAMESPACE_TOKEN; value:= ''; end else if value = 'parent' then begin symbol:= XPATH_AXIS_NAME_PARENT_TOKEN; FLastSymbol:= XPATH_AXIS_NAME_PARENT_TOKEN; value:= ''; end else if value = 'preceding' then begin symbol:= XPATH_AXIS_NAME_PRECEDING_TOKEN; FLastSymbol:= XPATH_AXIS_NAME_PRECEDING_TOKEN; end else if value = 'preceding-sibling' then begin symbol:= XPATH_AXIS_NAME_PRECEDING_SIBLING_TOKEN; FLastSymbol:= XPATH_AXIS_NAME_PRECEDING_SIBLING_TOKEN; value:= ''; end else if value = 'self' then begin symbol:= XPATH_AXIS_NAME_SELF_TOKEN; FLastSymbol:= XPATH_AXIS_NAME_SELF_TOKEN; value:= ''; end else begin symbol:= XPATH_INVALID_TOKEN; FLastSymbol:= XPATH_INVALID_TOKEN; value:= ''; end; position:= FPosition; exit; end; if S = #$3a then begin // ':' ? inc(FPosition); if not lookAheadNextWideChar(S) then begin symbol:= XPATH_INVALID_TOKEN; FLastSymbol:= XPATH_INVALID_TOKEN; position:= FPosition; value:= concat(value,':'); exit; end; if S = #$3a then begin // '::' ? dec(FPosition); end else begin value:= concat(value,':'); if not ( IsXmlLetter(S) or ( S = #$5f ) ) then begin // Letter or '_'? if S = #$2a then begin // '* symbol:= XPATH_NAME_TEST_TOKEN; FLastSymbol:= XPATH_NAME_TEST_TOKEN; end else begin symbol:= XPATH_INVALID_TOKEN; FLastSymbol:= XPATH_INVALID_TOKEN; end; inc(FPosition); position:= FPosition; value:= concat(value,wideString(S)); exit; end; while IsXmlNCNameChar(S) do begin inc(FPosition); value:= concat(value,wideString(S)); if not self.lookAheadNextWideChar(S) then break; end; end; end; if leftParanthesisFollows then begin if value = 'comment' then begin symbol:= XPATH_NODE_TYPE_COMMENT_TOKEN; FLastSymbol:= XPATH_NODE_TYPE_COMMENT_TOKEN; value:= ''; end else if value = 'text' then begin symbol:= XPATH_NODE_TYPE_TEXT_TOKEN; FLastSymbol:= XPATH_NODE_TYPE_TEXT_TOKEN; value:= ''; end else if value = 'processing-instruction' then begin symbol:= XPATH_NODE_TYPE_PI_TOKEN; FLastSymbol:= XPATH_NODE_TYPE_PI_TOKEN; value:= ''; end else if value = 'node' then begin symbol:= XPATH_NODE_TYPE_NODE_TOKEN; FLastSymbol:= XPATH_NODE_TYPE_NODE_TOKEN; value:= ''; end else begin symbol:= XPATH_FUNCTION_NAME_TOKEN; FLastSymbol:= XPATH_FUNCTION_NAME_TOKEN; end; end else begin symbol:= XPATH_NAME_TEST_TOKEN; FLastSymbol:= XPATH_NAME_TEST_TOKEN; end; position:= FPosition; end; {case ... else ...} end; SL_XPATH_AXIS_NAME_DESCENDANT_OR_SELF_TOKEN_FOLLOWS: begin symbol:= XPATH_AXIS_NAME_DESCENDANT_OR_SELF_TOKEN; // FLastSymbol:= XPATH_AXIS_NAME_DESCENDANT_OR_SELF_TOKEN; // FLastSymbol will never be evaluated, so we do not need to set it. position:= FPosition; value:= ''; FDoubleSlashStatus:= SL_XPATH_DOUBLE_COLON_TOKEN_FOLLOWS; end; SL_XPATH_DOUBLE_COLON_TOKEN_FOLLOWS: begin symbol:= XPATH_DOUBLE_COLON_TOKEN; // FLastSymbol:= XPATH_DOUBLE_COLON_TOKEN; // FLastSymbol will never be evaluated, so we do not need to set it. position:= FPosition; value:= ''; FDoubleSlashStatus:= SL_XPATH_NODE_TYPE_NODE_TOKEN_FOLLOWS; end; SL_XPATH_NODE_TYPE_NODE_TOKEN_FOLLOWS: begin symbol:= XPATH_NODE_TYPE_NODE_TOKEN; // FLastSymbol:= XPATH_NODE_TYPE_NODE_TOKEN; // FLastSymbol will never be evaluated, so we do not need to set it. position:= FPosition; value:= ''; FDoubleSlashStatus:= SL_XPATH_LEFT_PARENTHESIS_FOLLOWS; end; SL_XPATH_LEFT_PARENTHESIS_FOLLOWS: begin symbol:= XPATH_LEFT_PARENTHESIS_TOKEN; // FLastSymbol:= XPATH_LEFT_PARENTHESIS_TOKEN; // FLastSymbol will never be evaluated, so we do not need to set it. position:= FPosition; value:= ''; FDoubleSlashStatus:= SL_XPATH_RIGHT_PARENTHESIS_FOLLOWS; end; SL_XPATH_RIGHT_PARENTHESIS_FOLLOWS: begin symbol:= XPATH_RIGHT_PARENTHESIS_TOKEN; // FLastSymbol:= XPATH_RIGHT_PARENTHESIS_TOKEN; // FLastSymbol will never be evaluated, so we do not need to set it. position:= FPosition; value:= ''; FDoubleSlashStatus:= SL_XPATH_SLASH_OPERATOR_TOKEN_FOLLLOWS; end; SL_XPATH_SLASH_OPERATOR_TOKEN_FOLLLOWS: begin symbol:= XPATH_SLASH_OPERATOR_TOKEN; FLastSymbol:= XPATH_SLASH_OPERATOR_TOKEN; position:= FPosition; value:= ''; FDoubleSlashStatus:= SL_NO_DOUBLE_SLASH; end; end; {case FDoubleSlashStatus ...} end; procedure TdomXPathTokenizer.reset; begin FCacheIsActive:= false; FLastSymbol:= XPATH_INVALID_TOKEN; // Use XPATH_INVALID_TOKEN as a dummy value FPosition:= 0; FDoubleSlashStatus:= SL_NO_DOUBLE_SLASH; end; { TdomXPathExpression } constructor TdomXPathExpression.create(const aOwner: TdomDocument; const expression: wideString; const resolver: TdomXPathNSResolver); begin FExpression:= expression; FIsPrepared:= false; FIsValid:= false; FOwnerDocument:= aOwner; FResolver:= resolver; FSyntaxTree:= nil; end; function TdomXPathExpression.createSyntaxNode(const symbol: TdomXPathTokenType; const value: wideString): TdomXPathSyntaxNode; begin case symbol of XPATH_LEFT_PARENTHESIS_TOKEN: result:= TdomXPathLeftParenthesis.create(value); XPATH_RIGHT_PARENTHESIS_TOKEN: result:= TdomXPathRightParenthesis.create(value); XPATH_LEFT_SQUARE_BRACKET_TOKEN: result:= TdomXPathLeftSquareBracket.create(value); XPATH_RIGHT_SQUARE_BRACKET_TOKEN: result:= TdomXPathRightSquareBracket.create(value); XPATH_SINGLE_DOT_TOKEN: result:= TdomXPathSingleDot.create(value); XPATH_DOUBLE_DOT_TOKEN: result:= TdomXPathDoubleDot.create(value); XPATH_COMMERCIAL_AT_TOKEN: result:= TdomXPathCommercialAt.create(value); XPATH_COMMA_TOKEN: result:= TdomXPathComma.create(value); XPATH_DOUBLE_COLON_TOKEN: result:= TdomXPathDoubleColon.create(value); XPATH_NAME_TEST_TOKEN: result:= TdomXPathNameTest.create(value); XPATH_NODE_TYPE_COMMENT_TOKEN: result:= TdomXPathNodeTypeComment.create(value); XPATH_NODE_TYPE_TEXT_TOKEN: result:= TdomXPathNodeTypeText.create(value); XPATH_NODE_TYPE_PI_TOKEN: result:= TdomXPathNodeTypePI.create(value); XPATH_NODE_TYPE_NODE_TOKEN: result:= TdomXPathNodeTypeNode.create(value); XPATH_AND_OPERATOR_TOKEN: result:= TdomXPathAndOperator.create(value); XPATH_OR_OPERATOR_TOKEN: result:= TdomXPathOrOperator.create(value); XPATH_MOD_OPERATOR_TOKEN: result:= TdomXPathModOperator.create(value); XPATH_DIV_OPERATOR_TOKEN: result:= TdomXPathDivOperator.create(value); XPATH_MULTIPLY_OPERATOR_TOKEN: result:= TdomXPathMultiplyOperator.create(value); XPATH_SLASH_OPERATOR_TOKEN: result:= TdomXPathSlashOperator.create(value); XPATH_SHEFFER_STROKE_OPERATOR_TOKEN: result:= TdomXPathShefferStrokeOperator.create(value); XPATH_PLUS_OPERATOR_TOKEN: result:= TdomXPathPlusOperator.create(value); XPATH_MINUS_OPERATOR_TOKEN: result:= TdomXPathMinusOperator.create(value); XPATH_IS_EQUAL_OPERATOR_TOKEN: result:= TdomXPathIsEqualOperator.create(value); XPATH_IS_NOT_EQUAL_OPERATOR_TOKEN: result:= TdomXPathIsNotEqualOperator.create(value); XPATH_LESS_THAN_OPERATOR_TOKEN: result:= TdomXPathLessThanOperator.create(value); XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN: result:= TdomXPathLessThanOrEqualOperator.create(value); XPATH_GREATER_THAN_OPERATOR_TOKEN: result:= TdomXPathGreaterThanOperator.create(value); XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN: result:= TdomXPathGreaterThanOrEqualOperator.create(value); XPATH_FUNCTION_NAME_TOKEN: result:= TdomXPathFunctionName.create(value); XPATH_AXIS_NAME_ANCESTOR_TOKEN: result:= TdomXPathAxisNameAncestor.create(value); XPATH_AXIS_NAME_ANCESTOR_OR_SELF_TOKEN: result:= TdomXPathAxisNameAncestorOrSelf.create(value); XPATH_AXIS_NAME_ATTRIBUTE_TOKEN: result:= TdomXPathAxisNameAttribute.create(value); XPATH_AXIS_NAME_CHILD_TOKEN: result:= TdomXPathAxisNameChild.create(value); XPATH_AXIS_NAME_DESCENDANT_TOKEN: result:= TdomXPathAxisNameDescendant.create(value); XPATH_AXIS_NAME_DESCENDANT_OR_SELF_TOKEN: result:= TdomXPathAxisNameDescendantOrSelf.create(value); XPATH_AXIS_NAME_FOLLOWING_TOKEN: result:= TdomXPathAxisNameFollowing.create(value); XPATH_AXIS_NAME_FOLLOWING_SIBLING_TOKEN: result:= TdomXPathAxisNameFollowingSibling.create(value); XPATH_AXIS_NAME_NAMESPACE_TOKEN: result:= TdomXPathAxisNameNamespace.create(value); XPATH_AXIS_NAME_PARENT_TOKEN: result:= TdomXPathAxisNameParent.create(value); XPATH_AXIS_NAME_PRECEDING_TOKEN: result:= TdomXPathAxisNamePreceding.create(value); XPATH_AXIS_NAME_PRECEDING_SIBLING_TOKEN: result:= TdomXPathAxisNamePrecedingSibling.create(value); XPATH_AXIS_NAME_SELF_TOKEN: result:= TdomXPathAxisNameSelf.create(value); XPATH_LITERAL_TOKEN: result:= TdomXPathLiteral.create(value); XPATH_NUMBER_TOKEN: result:= TdomXPathNumber.create(value); XPATH_VARIABLE_REFERENCE_TOKEN: result:= TdomXPathVariableReference.create(value); else result:= nil; end; end; function TdomXPathExpression.evaluate(const contextNode: TdomNode; const typeCodes: TdomXPathResultTypes; const oldResult: TdomXPathResult): TdomXPathResult; var dummyResult: TdomXPathResult; begin if contextnode.ownerDocument <> FOwnerDocument then begin if assigned(oldResult) then oldResult.free; raise EWrong_Document_Err.create('Wrong document error.'); end; if ( (contextNode.nodeType = ntText_Node) and (contextNode.nodeValue = '') ) or not (contextNode.nodeType in [ ntElement_Node, ntAttribute_Node, ntText_Node, ntCDATA_Section_Node, ntProcessing_Instruction_Node, ntComment_Node, ntDocument_Node, ntXPath_Namespace_Node ] ) then begin if assigned(oldResult) then oldResult.free; raise ENot_Supported_Err.create('Not supported error.'); end; if prepare then begin result:= FSyntaxTree.evaluate(contextNode,oldResult,FResolver); if not(result.resultType in typeCodes) then begin if XPATH_BOOLEAN_TYPE in typeCodes then begin dummyResult:= result; result:= XPathBooleanFunc(dummyResult); end else if XPATH_NUMBER_TYPE in typeCodes then begin dummyResult:= result; result:= XPathNumberFunc(dummyResult); end else if XPATH_STRING_TYPE in typeCodes then begin dummyResult:= result; result:= XPathStringFunc(dummyResult); end else begin result.free; raise EXPath_Type_Err.create('XPath type error.'); end; end; end else begin if assigned(oldResult) then oldResult.free; raise EXPath_Invalid_Expression_Err.create('Invalid XPath expression error.'); end; end; function TdomXPathExpression.prepare: boolean; var position: integer; stack: TdomXPathSyntaxNodeStack; symbol: TdomXPathTokenType; tokenizer: TdomXPathTokenizer; value: wideString; axisNode: TdomXPathSyntaxNode; lastSyntaxNode: TdomXPathSyntaxNode; newSyntaxNode: TdomXPathSyntaxNode; nodeTestNode: TdomXPathSyntaxNode; lastArgument: TdomXPathArgument; newArgument: TdomXPathArgument; nodeTypePI: TdomXPathSyntaxNode; PILiteral: TdomXPathSyntaxNode; begin if not FIsPrepared then begin tokenizer:= TdomXPathTokenizer.create(FExpression,'1.0'); try stack:= TdomXPathSyntaxNodeStack.create; try repeat tokenizer.read(symbol,value,position); case symbol of XPATH_END_OF_TEXT_TOKEN, XPATH_INVALID_TOKEN: break; else lastSyntaxNode:= createSyntaxNode(symbol,value); repeat // -- if lastSyntaxNode is TdomXPathAbsoluteLocationPath then ... -- // (TdomXPathAbsoluteLocationPath will not appear in this loop, // so we leave it out here.) if lastSyntaxNode is TdomXPathAndExpr then begin if tokenizer.isFollowing(XPATH_SHEFFER_STROKE_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_MULTIPLY_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_DIV_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_MOD_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_PLUS_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_MINUS_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_LESS_THAN_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_GREATER_THAN_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_IS_EQUAL_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_IS_NOT_EQUAL_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_AND_OPERATOR_TOKEN) then begin // Operator of higher precedence is following, so we postpone building the expression. stack.push(lastSyntaxNode); break; end; if (stack.peek(0) is TdomXPathOrOperator) and ( (stack.peek(1) is TdomXPathOrExpr) ) then begin // XPath 1.0, prod. [21]: stack.pop.free; newSyntaxNode:= TdomXPathOrExpr.create(''); // Create OrExpr. newSyntaxNode.left:= stack.pop; // Append OrExpr. newSyntaxNode.right:= lastSyntaxNode; // Append AndExpr. lastSyntaxNode:= newSyntaxNode; end else begin // XPath 1.0, prod. [21]: newSyntaxNode:= TdomXPathOrExpr.create(''); // Create OrExpr. newSyntaxNode.left:= lastSyntaxNode; // Append AndExpr. lastSyntaxNode:= newSyntaxNode; end; end else if (lastSyntaxNode is TdomXPathAndOperator) or // (lastSyntaxNode is TdomXPathArgument) or // TdomXPathArgument will not appear in this loop, so we leave it out here. (lastSyntaxNode is TdomXPathComma) or (lastSyntaxNode is TdomXPathCommercialAt) or (lastSyntaxNode is TdomXPathCustomAxisName) then begin stack.push(lastSyntaxNode); break; end else if (lastSyntaxNode is TdomXPathDivExpr) or (lastSyntaxNode is TdomXPathModExpr) or (lastSyntaxNode is TdomXPathMultiplyExpr) then begin if tokenizer.isFollowing(XPATH_SHEFFER_STROKE_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_MULTIPLY_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_DIV_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_MOD_OPERATOR_TOKEN) then begin // Operator of higher precedence is following, so we postpone building the expression. stack.push(lastSyntaxNode); break; end; if (stack.peek(0) is TdomXPathPlusOperator) and ( (stack.peek(1) is TdomXPathPlusExpr) or (stack.peek(1) is TdomXPathMinusExpr) ) then begin // XPath 1.0, prod. [25]: stack.pop.free; newSyntaxNode:= TdomXPathPlusExpr.create(''); // Create PlusExpr. newSyntaxNode.left:= stack.pop; // Append AdditiveExpr. newSyntaxNode.right:= lastSyntaxNode; // Append MultiplicativeExpr. lastSyntaxNode:= newSyntaxNode; end else if (stack.peek(0) is TdomXPathMinusOperator) and ( (stack.peek(1) is TdomXPathPlusExpr) or (stack.peek(1) is TdomXPathMinusExpr) ) then begin // XPath 1.0, prod. [25]: stack.pop.free; newSyntaxNode:= TdomXPathMinusExpr.create(''); // Create MinusExpr. newSyntaxNode.left:= stack.pop; // Append AdditiveExpr. newSyntaxNode.right:= lastSyntaxNode; // Append MultiplicativeExpr. lastSyntaxNode:= newSyntaxNode; end else begin // XPath 1.0, prod. [25]: newSyntaxNode:= TdomXPathPlusExpr.create(''); // Create PlusExpr. newSyntaxNode.left:= lastSyntaxNode; // Append MultiplicativeExpr. lastSyntaxNode:= newSyntaxNode; end; end else if (lastSyntaxNode is TdomXPathDivOperator) or (lastSyntaxNode is TdomXPathDoubleColon) then begin stack.push(lastSyntaxNode); break; end else if lastSyntaxNode is TdomXPathDoubleDot then begin // XPath 1.0, prod. [12]: lastSyntaxNode.free; lastSyntaxNode:= TdomXPathStep.create(''); lastSyntaxNode.left:= TdomXPathAxisNameParent.create(''); lastSyntaxNode.left.left:= TdomXPathNodeTest.create(''); lastSyntaxNode.left.left.left:= TdomXPathNodeTypeNode.create(''); end else if lastSyntaxNode is TdomXPathExpr then begin stack.push(lastSyntaxNode); break; end else if lastSyntaxNode is TdomXPathFilterExpr then begin // XPath 1.0, prod. [19]: if tokenizer.isFollowing(XPATH_SLASH_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_LEFT_SQUARE_BRACKET_TOKEN) then begin // A Slash or Predicate is following, so we postpone building the PathExpr. stack.push(lastSyntaxNode); break; end; newSyntaxNode:= TdomXPathPathExpr.create(''); // Create PathExpr. newSyntaxNode.left:= lastSyntaxNode; // Append FilterExpr. lastSyntaxNode:= newSyntaxNode; end else if lastSyntaxNode is TdomXPathFunctionCall then begin // XPath 1.0, prod. [15]: newSyntaxNode:= TdomXPathPrimaryExpr.create(''); // Create PrimaryExpr. newSyntaxNode.left:= lastSyntaxNode; // Append FunctionCall. lastSyntaxNode:= newSyntaxNode; end else if lastSyntaxNode is TdomXPathFunctionName then begin stack.push(lastSyntaxNode); break; end else if (lastSyntaxNode is TdomXPathGreaterThanExpr) or (lastSyntaxNode is TdomXPathGreaterThanOrEqualExpr) or (lastSyntaxNode is TdomXPathLessThanExpr) or (lastSyntaxNode is TdomXPathLessThanOrEqualExpr) then begin if tokenizer.isFollowing(XPATH_SHEFFER_STROKE_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_MULTIPLY_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_DIV_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_MOD_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_PLUS_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_MINUS_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_LESS_THAN_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_GREATER_THAN_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN) then begin // Operator of higher precedence is following, so we postpone building the expression. stack.push(lastSyntaxNode); break; end; if (stack.peek(0) is TdomXPathIsEqualOperator) and ( (stack.peek(1) is TdomXPathIsEqualExpr) or (stack.peek(1) is TdomXPathIsNotEqualExpr) ) then begin // XPath 1.0, prod. [23]: stack.pop.free; newSyntaxNode:= TdomXPathIsEqualExpr.create(''); // Create IsEqualExpr. newSyntaxNode.left:= stack.pop; // Append EqualityExpr. newSyntaxNode.right:= lastSyntaxNode; // Append RelationalExpr. lastSyntaxNode:= newSyntaxNode; end else if (stack.peek(0) is TdomXPathIsNotEqualOperator) and ( (stack.peek(1) is TdomXPathIsEqualExpr) or (stack.peek(1) is TdomXPathIsNotEqualExpr) ) then begin // XPath 1.0, prod. [23]: stack.pop.free; newSyntaxNode:= TdomXPathIsNotEqualExpr.create(''); // Create IsNotEqualExpr. newSyntaxNode.left:= stack.pop; // Append EqualityExpr. newSyntaxNode.right:= lastSyntaxNode; // Append RelationalExpr. lastSyntaxNode:= newSyntaxNode; end else begin // XPath 1.0, prod. [23]: newSyntaxNode:= TdomXPathIsEqualExpr.create(''); // Create IsEqualExpr. newSyntaxNode.left:= lastSyntaxNode; // Append RelationalExpr. lastSyntaxNode:= newSyntaxNode; end; end else if (lastSyntaxNode is TdomXPathGreaterThanOperator) or (lastSyntaxNode is TdomXPathGreaterThanOrEqualOperator) then begin stack.push(lastSyntaxNode); break; end else if (lastSyntaxNode is TdomXPathIsEqualExpr) or (lastSyntaxNode is TdomXPathIsNotEqualExpr) then begin if tokenizer.isFollowing(XPATH_SHEFFER_STROKE_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_MULTIPLY_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_DIV_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_MOD_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_PLUS_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_MINUS_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_LESS_THAN_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_GREATER_THAN_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_IS_EQUAL_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_IS_NOT_EQUAL_OPERATOR_TOKEN) then begin // Operator of higher precedence is following, so we postpone building the expression. stack.push(lastSyntaxNode); break; end; if (stack.peek(0) is TdomXPathAndOperator) and ( (stack.peek(1) is TdomXPathAndExpr) ) then begin // XPath 1.0, prod. [22]: stack.pop.free; newSyntaxNode:= TdomXPathAndExpr.create(''); // Create AndExpr. newSyntaxNode.left:= stack.pop; // Append AndExpr. newSyntaxNode.right:= lastSyntaxNode; // Append EqualityExpr. lastSyntaxNode:= newSyntaxNode; end else begin // XPath 1.0, prod. [22]: newSyntaxNode:= TdomXPathAndExpr.create(''); // Create AndExpr. newSyntaxNode.left:= lastSyntaxNode; // Append EqualityExpr. lastSyntaxNode:= newSyntaxNode; end; end else if (lastSyntaxNode is TdomXPathIsEqualOperator) or (lastSyntaxNode is TdomXPathIsNotEqualOperator) or (lastSyntaxNode is TdomXPathLeftParenthesis) or (lastSyntaxNode is TdomXPathLeftSquareBracket) or (lastSyntaxNode is TdomXPathLessThanOperator) or (lastSyntaxNode is TdomXPathLessThanOrEqualOperator) then begin stack.push(lastSyntaxNode); break; end else if lastSyntaxNode is TdomXPathLiteral then begin if (stack.peek(0) is TdomXPathLeftParenthesis) and (stack.peek(1) is TdomXPathNodeTypePI) and tokenizer.isFollowing(XPATH_RIGHT_PARENTHESIS_TOKEN) then begin // Literal is part of a processing-instruction node test, // so we postpone building the expression. stack.push(lastSyntaxNode); break; end else begin // XPath 1.0, prod. [15]: newSyntaxNode:= TdomXPathPrimaryExpr.create(''); // Create PrimaryExpr. newSyntaxNode.left:= lastSyntaxNode; // Append Literal. lastSyntaxNode:= newSyntaxNode; end; end else if (lastSyntaxNode is TdomXPathMinusExpr) or (lastSyntaxNode is TdomXPathPlusExpr) then begin if tokenizer.isFollowing(XPATH_SHEFFER_STROKE_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_MULTIPLY_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_DIV_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_MOD_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_PLUS_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_MINUS_OPERATOR_TOKEN) then begin // Operator of higher precedence is following, so we postpone building the expression. stack.push(lastSyntaxNode); break; end; if (stack.peek(0) is TdomXPathLessThanOperator) and ( (stack.peek(1) is TdomXPathLessThanExpr) or (stack.peek(1) is TdomXPathLessThanOrEqualExpr) or (stack.peek(1) is TdomXPathGreaterThanExpr) or (stack.peek(1) is TdomXPathGreaterThanOrEqualExpr) ) then begin // XPath 1.0, prod. [24]: stack.pop.free; newSyntaxNode:= TdomXPathLessThanExpr.create(''); // Create LessThanExpr. newSyntaxNode.left:= stack.pop; // Append RelationalExpr. newSyntaxNode.right:= lastSyntaxNode; // Append AdditiveExpr. lastSyntaxNode:= newSyntaxNode; end else if (stack.peek(0) is TdomXPathLessThanOrEqualOperator) and ( (stack.peek(1) is TdomXPathLessThanExpr) or (stack.peek(1) is TdomXPathLessThanOrEqualExpr) or (stack.peek(1) is TdomXPathGreaterThanExpr) or (stack.peek(1) is TdomXPathGreaterThanOrEqualExpr) ) then begin // XPath 1.0, prod. [24]: stack.pop.free; newSyntaxNode:= TdomXPathLessThanOrEqualExpr.create(''); // Create LessThanOrEqualExpr. newSyntaxNode.left:= stack.pop; // Append RelationalExpr. newSyntaxNode.right:= lastSyntaxNode; // Append AdditiveExpr. lastSyntaxNode:= newSyntaxNode; end else if (stack.peek(0) is TdomXPathGreaterThanOperator) and ( (stack.peek(1) is TdomXPathLessThanExpr) or (stack.peek(1) is TdomXPathLessThanOrEqualExpr) or (stack.peek(1) is TdomXPathGreaterThanExpr) or (stack.peek(1) is TdomXPathGreaterThanOrEqualExpr) ) then begin // XPath 1.0, prod. [24]: stack.pop.free; newSyntaxNode:= TdomXPathGreaterThanExpr.create(''); // Create GreaterThanExpr. newSyntaxNode.left:= stack.pop; // Append RelationalExpr. newSyntaxNode.right:= lastSyntaxNode; // Append AdditiveExpr. lastSyntaxNode:= newSyntaxNode; end else if (stack.peek(0) is TdomXPathGreaterThanOrEqualOperator) and ( (stack.peek(1) is TdomXPathLessThanExpr) or (stack.peek(1) is TdomXPathLessThanOrEqualExpr) or (stack.peek(1) is TdomXPathGreaterThanExpr) or (stack.peek(1) is TdomXPathGreaterThanOrEqualExpr) ) then begin // XPath 1.0, prod. [24]: stack.pop.free; newSyntaxNode:= TdomXPathGreaterThanOrEqualExpr.create(''); // Create GreaterThanOrEqualExpr. newSyntaxNode.left:= stack.pop; // Append RelationalExpr. newSyntaxNode.right:= lastSyntaxNode; // Append AdditiveExpr. lastSyntaxNode:= newSyntaxNode; end else begin // XPath 1.0, prod. [24]: newSyntaxNode:= TdomXPathLessThanExpr.create(''); // Create LessThanExpr. newSyntaxNode.left:= lastSyntaxNode; // Append AdditiveExpr. lastSyntaxNode:= newSyntaxNode; end; end else if (lastSyntaxNode is TdomXPathMinusOperator) or (lastSyntaxNode is TdomXPathModOperator) or (lastSyntaxNode is TdomXPathMultiplyOperator) then begin stack.push(lastSyntaxNode); break; end else if lastSyntaxNode is TdomXPathNameTest then begin // XPath 1.0, prod. [7]: newSyntaxNode:= TdomXPathNodeTest.create(''); // Create NodeTest. newSyntaxNode.left:= lastSyntaxNode; // Append NameTest. lastSyntaxNode:= newSyntaxNode; end else if lastSyntaxNode is TdomXPathNodeTest then begin // XPath 1.0, prod. [4]: if tokenizer.isFollowing(XPATH_LEFT_SQUARE_BRACKET_TOKEN) then begin // A Predicate is following, so we postpone building the Step. stack.push(lastSyntaxNode); break; end; if stack.peek(0) is TdomXPathDoubleColon then begin if stack.peek(1) is TdomXPathCustomAxisName then begin stack.pop.free; newSyntaxNode:= stack.pop; newSyntaxNode.left:= lastSyntaxNode; // Append NodeTest to AxisName. lastSyntaxNode:= TdomXPathStep.create(''); // Create Step. lastSyntaxNode.left:= newSyntaxNode; // Append AxisName to Step. end else begin // Malformed XPath Expression. We are parsing it anyway ... stack.push(lastSyntaxNode); break; end; end else if stack.peek(0) is TdomXPathCommercialAt then begin // XPath 1.0, prod. [13]: stack.pop.free; newSyntaxNode:= TdomXPathAxisNameAttribute.create(''); newSyntaxNode.left:= lastSyntaxNode; // Append NodeTest to AxisName. lastSyntaxNode:= TdomXPathStep.create(''); // Create Step. lastSyntaxNode.left:= newSyntaxNode; // Append AxisName to Step. end else begin // XPath 1.0, prod. [13]: newSyntaxNode:= TdomXPathAxisNameChild.create(''); newSyntaxNode.left:= lastSyntaxNode; // Append NodeTest to AxisName. lastSyntaxNode:= TdomXPathStep.create(''); // Create Step. lastSyntaxNode.left:= newSyntaxNode; // Append AxisName to Step. end; end else if (lastSyntaxNode is TdomXPathNodeTypeComment) or (lastSyntaxNode is TdomXPathNodeTypeNode) or (lastSyntaxNode is TdomXPathNodeTypePI) or (lastSyntaxNode is TdomXPathNodeTypeText) then begin stack.push(lastSyntaxNode); break; end else if lastSyntaxNode is TdomXPathNumber then begin // XPath 1.0, prod. [15]: newSyntaxNode:= TdomXPathPrimaryExpr.create(''); // Create PrimaryExpr. newSyntaxNode.left:= lastSyntaxNode; // Append Number. lastSyntaxNode:= newSyntaxNode; end else if lastSyntaxNode is TdomXPathOrExpr then begin if tokenizer.isFollowing(XPATH_SHEFFER_STROKE_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_MULTIPLY_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_DIV_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_MOD_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_PLUS_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_MINUS_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_LESS_THAN_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_LESS_THAN_OR_EQUAL_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_GREATER_THAN_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_GREATER_THAN_OR_EQUAL_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_IS_EQUAL_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_IS_NOT_EQUAL_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_AND_OPERATOR_TOKEN) or tokenizer.isFollowing(XPATH_OR_OPERATOR_TOKEN) then begin // Operator of higher precedence is following, so we postpone building the expression. stack.push(lastSyntaxNode); break; end; // XPath 1.0, prod. [14]: newSyntaxNode:= TdomXPathExpr.create(''); // Create Expr. newSyntaxNode.left:= lastSyntaxNode; // Append OrExpr. lastSyntaxNode:= newSyntaxNode; end else if lastSyntaxNode is TdomXPathOrOperator then begin stack.push(lastSyntaxNode); break; end else if lastSyntaxNode is TdomXPathPathExpr then begin // XPath 1.0, prod. [18]: if tokenizer.isFollowing(XPATH_SLASH_OPERATOR_TOKEN) then begin // A Slash is following, so we postpone building the TdomXPathUnionExpr. stack.push(lastSyntaxNode); break; end; if (stack.peek(0) is TdomXPathShefferStrokeOperator) and (stack.peek(1) is TdomXPathUnionExpr) then begin stack.pop.free; newSyntaxNode:= TdomXPathUnionExpr.create(''); // Create UnionExpr. newSyntaxNode.left:= stack.pop; // Append UnionExpr. newSyntaxNode.right:= lastSyntaxNode; // Append PathExpr. lastSyntaxNode:= newSyntaxNode; end else begin newSyntaxNode:= TdomXPathUnionExpr.create(''); // Create UnionExpr. newSyntaxNode.left:= lastSyntaxNode; // Append PathExpr. lastSyntaxNode:= newSyntaxNode; end; end else if lastSyntaxNode is TdomXPathPlusOperator then begin stack.push(lastSyntaxNode); break; end else if lastSyntaxNode is TdomXPathPredicate then begin if stack.peek(0) is TdomXPathFilterExpr then begin // XPath 1.0, prod. [20]: newSyntaxNode:= TdomXPathFilterExpr.create(''); newSyntaxNode.left:= stack.pop; newSyntaxNode.right:= lastSyntaxNode; lastSyntaxNode:= newSyntaxNode; end else begin // XPath 1.0, prod. [4]: if tokenizer.isFollowing(XPATH_LEFT_SQUARE_BRACKET_TOKEN) then begin // Another Predicate is following, so we postpone building the Step. stack.push(lastSyntaxNode); break; end; if stack.peek(0) is TdomXPathPredicate then begin newSyntaxNode:= stack.pop; newSyntaxNode.right:= lastSyntaxNode; lastSyntaxNode:= newSyntaxNode; end else if stack.peek(0) is TdomXPathNodeTest then begin if stack.peek(1) is TdomXPathDoubleColon then begin if stack.peek(2) is TdomXPathCustomAxisName then begin nodeTestNode:= stack.pop; // Pop the NodeTest from the stack. stack.pop.free; // Pop and delete the DoubleColon. axisNode:= stack.pop; // Pop the AxisName from the stack. axisNode.left:= nodeTestNode; // Append NodeTest to AxisName. axisNode.right:= lastSyntaxNode; // Append Predicate to AxisName. lastSyntaxNode:= TdomXPathStep.create(''); // Create Step. lastSyntaxNode.left:= axisNode; // Append AxisName to Step. end else begin // Malformed XPath Expression. We are parsing it anyway ... stack.push(lastSyntaxNode); break; end; end else if stack.peek(1) is TdomXPathCommercialAt then begin // XPath 1.0, prod. [13]: nodeTestNode:= stack.pop; // Pop the NodeTest from the stack. stack.pop.free; // Pop and delete the DoubleColon. axisNode:= TdomXPathAxisNameAttribute.create(''); // Create attribute axis AxisName. axisNode.left:= nodeTestNode; // Append NodeTest to AxisName. axisNode.right:= lastSyntaxNode; // Append Predicate to AxisName. lastSyntaxNode:= TdomXPathStep.create(''); // Create Step. lastSyntaxNode.left:= axisNode; // Append AxisName to Step. end else begin // XPath 1.0, prod. [13]: nodeTestNode:= stack.pop; // Pop the NodeTest from the stack. axisNode:= TdomXPathAxisNameChild.create(''); // Create child axis AxisName. axisNode.left:= nodeTestNode; // Append NodeTest to AxisName. axisNode.right:= lastSyntaxNode; // Append Predicate to AxisName. lastSyntaxNode:= TdomXPathStep.create(''); // Create Step. lastSyntaxNode.left:= axisNode; // Append AxisName to Step. end; end else begin // Malformed XPath Expression. We are parsing it anyway ... stack.push(lastSyntaxNode); break; end; end; end else if lastSyntaxNode is TdomXPathPrimaryExpr then begin // XPath 1.0, prod. [20]: newSyntaxNode:= TdomXPathFilterExpr.create(''); // Create FilterExpr. newSyntaxNode.left:= lastSyntaxNode; // Append PrimaryExpr. lastSyntaxNode:= newSyntaxNode; end else if lastSyntaxNode is TdomXPathRightParenthesis then begin // XPath 1.0, prod. [7]: if (stack.peek(0) is TdomXPathLeftParenthesis) and ( (stack.peek(1) is TdomXPathNodeTypeComment) or (stack.peek(1) is TdomXPathNodeTypeNode) or (stack.peek(1) is TdomXPathNodeTypePI) or (stack.peek(1) is TdomXPathNodeTypeText) ) then begin lastSyntaxNode.free; lastSyntaxNode:= TdomXPathNodeTest.create(''); stack.pop.free; lastSyntaxNode.left:= stack.pop; end else if (stack.peek(0) is TdomXPathLiteral) and (stack.peek(1) is TdomXPathLeftParenthesis) and (stack.peek(2) is TdomXPathNodeTypePI) then begin lastSyntaxNode.free; lastSyntaxNode:= TdomXPathNodeTest.create(''); // Create NodeTest PILiteral:= stack.pop; stack.pop.free; // Remove LeftParenthesist from stack. nodeTypePI:= stack.pop; nodeTypePI.left:= PILiteral; // Append Literal to NodeTypePI lastSyntaxNode.left:= nodeTypePI; // Append NodeTypePI to NodeTest end else if (stack.peek(0) is TdomXPathExpr) and (stack.peek(1) is TdomXPathLeftParenthesis) and not (stack.peek(2) is TdomXPathFunctionName) then begin // XPath 1.0, prod. [15]: lastSyntaxNode.free; lastSyntaxNode:= TdomXPathPrimaryExpr.create(''); // Create PrimaryExpr lastSyntaxNode.left:= stack.pop; // Append Expr stack.pop.free; // Remove LeftParenthesist from stack. end else if (stack.peek(0) is TdomXPathLeftParenthesis) and (stack.peek(1) is TdomXPathFunctionName) then begin // XPath 1.0, prod. [16]: stack.pop.free; lastSyntaxNode.free; lastSyntaxNode:= TdomXPathFunctionCall.create(''); // Create FunctionCall. lastSyntaxNode.left:= stack.pop; // Append FunctionName. end else begin // XPath 1.0, prod. [16]: lastArgument:= nil; while (stack.peek(0) is TdomXPathExpr) and (stack.peek(1) is TdomXPathComma) do begin newArgument:= TdomXPathArgument.create(''); // Create Argument. newArgument.left:= stack.pop; // Append Expr. newArgument.right:= lastArgument; // Append last Argument (if any). lastArgument:= newArgument; stack.pop.free; end; if (stack.peek(0) is TdomXPathExpr) and (stack.peek(1) is TdomXPathLeftParenthesis) and (stack.peek(2) is TdomXPathFunctionName) then begin newArgument:= TdomXPathArgument.create(''); // Create Argument. newArgument.left:= stack.pop; // Append Expr. newArgument.right:= lastArgument; // Append last Argument (if any). stack.pop.free; lastSyntaxNode.free; lastSyntaxNode:= TdomXPathFunctionCall.create(''); // Create FunctionCall. lastSyntaxNode.left:= stack.pop; // Append FunctionName. lastSyntaxNode.right:= newArgument; // Append Argument. end else begin // Malformed XPath Expression. We are parsing it anyway ... if assigned(lastArgument) then stack.push(lastArgument); stack.push(lastSyntaxNode); break; end; end; end else if lastSyntaxNode is TdomXPathRightSquareBracket then begin // XPath 1.0, prod. [8] and [9]: if (stack.peek(0) is TdomXPathExpr) and (stack.peek(1) is TdomXPathLeftSquareBracket) then begin lastSyntaxNode.free; lastSyntaxNode:= TdomXPathPredicate.create(''); // Create Predicate. lastSyntaxNode.left:= stack.pop; // Append Expr. stack.pop.free; // Remove LeftSquareBracket from stack. end else begin // Malformed XPath Expression. We are parsing it anyway ... stack.push(lastSyntaxNode); break; end; end else if lastSyntaxNode is TdomXPathShefferStrokeOperator then begin if stack.peek(0) is TdomXPathPathExpr then begin newSyntaxNode:= TdomXPathUnionExpr.create(''); // Create UnionExpr. newSyntaxNode.left:= stack.pop; // Append PathExpr from stack. stack.push(newSyntaxNode); // Push the UnionExpr on the stack. stack.push(lastSyntaxNode); // Push the ShefferStrokeOperator on the stack. break; end else begin // Malformed XPath Expression. We are parsing it anyway ... stack.push(lastSyntaxNode); break; end; end else if lastSyntaxNode is TdomXPathSingleDot then begin // XPath 1.0, prod. [12]: lastSyntaxNode.free; lastSyntaxNode:= TdomXPathStep.create(''); // Create Step. lastSyntaxNode.left:= TdomXPathAxisNameSelf.create(''); // Create and append AxisName to Step. lastSyntaxNode.left.left:= TdomXPathNodeTest.create(''); // Create and append NodeTest to AxisName. lastSyntaxNode.left.left.left:= TdomXPathNodeTypeNode.create(''); // Create and append NodeType to NodeTest. end else if lastSyntaxNode is TdomXPathSlashOperator then begin // XPath 1.0, prod. [2]: if ( (not assigned(stack.peek(0))) or (stack.peek(0) is TdomXPathShefferStrokeOperator) ) and ( tokenizer.isFollowing(XPATH_END_OF_TEXT_TOKEN) or tokenizer.isFollowing(XPATH_SHEFFER_STROKE_OPERATOR_TOKEN) ) then begin lastSyntaxNode.free; lastSyntaxNode:= TdomXPathPathExpr.create(''); // Create PathExpr. lastSyntaxNode.left:= TdomXPathAbsoluteLocationPath.create(''); // Create and append AbsolutLocationPath. end else begin stack.push(lastSyntaxNode); break; end; end else if lastSyntaxNode is TdomXPathStep then begin // XPath 1.0, prod. [3] and [19]: if stack.peek(0) is TdomXPathSlashOperator then begin if stack.peek(1) is TdomXPathFilterExpr then begin stack.pop.free; newSyntaxNode:= TdomXPathPathExpr.create(''); // Create PathExpr. newSyntaxNode.left:= stack.pop; // Append FilterExpr to PathExpr. newSyntaxNode.right:= lastSyntaxNode; // Append Step to PathExpr. lastSyntaxNode:= newSyntaxNode; end else if stack.peek(1) is TdomXPathPathExpr then begin stack.pop.free; if TdomXPathPathExpr(stack.peek(0)).addStep(TdomXPathStep(lastSyntaxNode)) then begin lastSyntaxNode:= stack.pop; end else begin // Malformed XPath Expression. We are parsing it anyway ... stack.push(lastSyntaxNode); break; end; end else if (not assigned(stack.peek(1)) ) or (stack.peek(1) is TdomXPathShefferStrokeOperator) then begin // XPath 1.0, prod. [2]: stack.pop.free; newSyntaxNode:= TdomXPathPathExpr.create(''); // Create PathExpr. newSyntaxNode.left:= TdomXPathAbsoluteLocationPath.create(''); // Create and append AbsolutLocationPath. newSyntaxNode.right:= lastSyntaxNode; // Append Step. lastSyntaxNode:= newSyntaxNode; end else begin // Malformed XPath Expression. We are parsing it anyway ... stack.push(lastSyntaxNode); break; end; end else begin newSyntaxNode:= TdomXPathPathExpr.create(''); // Create PathExpr. newSyntaxNode.right:= lastSyntaxNode; // Append Step to PathExpr. lastSyntaxNode:= newSyntaxNode; end; end else if lastSyntaxNode is TdomXPathUnaryExpr then begin if tokenizer.isFollowing(XPATH_SHEFFER_STROKE_OPERATOR_TOKEN) then begin // Operator of higher precedence is following, so we postpone building the expression. stack.push(lastSyntaxNode); break; end; if (stack.peek(0) is TdomXPathMinusOperator) and not ( (stack.peek(1) is TdomXPathPlusExpr) or (stack.peek(1) is TdomXPathMinusExpr) or (stack.peek(1) is TdomXPathMultiplyExpr) or (stack.peek(1) is TdomXPathDivExpr) or (stack.peek(1) is TdomXPathModExpr) or (stack.peek(1) is TdomXPathUnaryExpr) or (stack.peek(1) is TdomXPathUnionExpr) ) then begin // XPath 1.0, prod. [27]: newSyntaxNode:= TdomXPathUnaryExpr.create(''); // Create UnaryExpr. newSyntaxNode.left:= stack.pop; // Append MinusOperator. newSyntaxNode.right:= lastSyntaxNode; // Append UnaryExpr. lastSyntaxNode:= newSyntaxNode; end else if (stack.peek(0) is TdomXPathMultiplyOperator) and ( (stack.peek(1) is TdomXPathMultiplyExpr) or (stack.peek(1) is TdomXPathDivExpr) or (stack.peek(1) is TdomXPathModExpr) ) then begin // XPath 1.0, prod. [26]: stack.pop.free; newSyntaxNode:= TdomXPathMultiplyExpr.create(''); // Create MultiplyExpr. newSyntaxNode.left:= stack.pop; // Append MultiplicativeExpr. newSyntaxNode.right:= lastSyntaxNode; // Append UnaryExpr. lastSyntaxNode:= newSyntaxNode; end else if (stack.peek(0) is TdomXPathDivOperator) and ( (stack.peek(1) is TdomXPathMultiplyExpr) or (stack.peek(1) is TdomXPathDivExpr) or (stack.peek(1) is TdomXPathModExpr) ) then begin // XPath 1.0, prod. [26]: stack.pop.free; newSyntaxNode:= TdomXPathDivExpr.create(''); // Create DivExpr. newSyntaxNode.left:= stack.pop; // Append MultiplicativeExpr. newSyntaxNode.right:= lastSyntaxNode; // Append UnaryExpr. lastSyntaxNode:= newSyntaxNode; end else if (stack.peek(0) is TdomXPathModOperator) and ( (stack.peek(1) is TdomXPathMultiplyExpr) or (stack.peek(1) is TdomXPathDivExpr) or (stack.peek(1) is TdomXPathModExpr) ) then begin // XPath 1.0, prod. [26]: stack.pop.free; newSyntaxNode:= TdomXPathModExpr.create(''); // Create ModExpr. newSyntaxNode.left:= stack.pop; // Append MultiplicativeExpr. newSyntaxNode.right:= lastSyntaxNode; // Append UnaryExpr. lastSyntaxNode:= newSyntaxNode; end else begin // XPath 1.0, prod. [26]: newSyntaxNode:= TdomXPathMultiplyExpr.create(''); // Create MultiplyExpr. newSyntaxNode.left:= lastSyntaxNode; // Append UnaryExpr. lastSyntaxNode:= newSyntaxNode; end; end else if lastSyntaxNode is TdomXPathUnionExpr then begin // XPath 1.0, prod. [27]: if tokenizer.isFollowing(XPATH_SHEFFER_STROKE_OPERATOR_TOKEN) then begin // A Sheffer's Stroke is following, so we postpone building the UnaryExpr. stack.push(lastSyntaxNode); break; end; newSyntaxNode:= TdomXPathUnaryExpr.create(''); // Create UnaryExpr. newSyntaxNode.left:= lastSyntaxNode; // Append the UnionExpr. lastSyntaxNode:= newSyntaxNode; end else if lastSyntaxNode is TdomXPathVariableReference then begin // XPath 1.0, prod. [15]: newSyntaxNode:= TdomXPathPrimaryExpr.create(''); // Create PrimaryExpr. newSyntaxNode.left:= lastSyntaxNode; // Append VariableReference. lastSyntaxNode:= newSyntaxNode; end; until false; end; {case ... else ...} until false; if assigned(FSyntaxTree) then FSyntaxTree.free; // Free the old syntax tree, if any. FIsPrepared:= true; // Is the syntax tree valid, i.e. does the evaluation reach the end of the text // and does the stack hold exactly one root node of type TdomXPathExpr? if (symbol = XPATH_END_OF_TEXT_TOKEN) and (stack.length = 1) and (stack.peek(0) is TdomXPathExpr) then begin FIsValid:= true; FSyntaxTree:= TdomXPathExpr(stack.pop); end else begin FIsValid:= false; FSyntaxTree:= nil; end; finally stack.free; end; finally tokenizer.free; end; end; result:= FIsValid; end; { TdomXPathNSResolver } constructor TdomXPathNSResolver.create(const resolverNode: TdomNode); var node: TdomNode; i: integer; begin FPrefixUriList:= TdomNameValueList.create; with FPrefixUriList do begin Sorted:= true; Duplicates:= dupIgnore; end; node:= resolverNode; while assigned(node) do begin with node do begin if nodeType = ntElement_Node then begin with attributes do begin for i:= 0 to pred(length) do with TdomAttr(item(i)) do if (namespaceURI = 'http://www.w3.org/2000/xmlns/') then if not (localName = 'xmlns') then FPrefixUriList.add(localName,nodeValue); end; {with ...} end; {if ...} node:= parentNode; end; {with ...} end; {while ...} end; destructor TdomXPathNSResolver.destroy; begin FPrefixUriList.free; inherited; end; function TdomXPathNSResolver.lookupNamespaceURI(const prefix: wideString): wideString; var index: integer; begin index:= FPrefixUriList.indexOfName(prefix); if index > -1 then result:= FPrefixUriList.names[index] else result:= ''; end; { TdomXPathSnapshotResult } constructor TdomXPathSnapshotResult.create; begin FAxisType:= XPATH_FORWARD_AXIS; FList:= TList.create; FResultType:= XPATH_NODE_SNAPSHOT_TYPE; end; destructor TdomXPathSnapshotResult.destroy; begin FList.free; inherited; end; procedure TdomXPathSnapshotResult.add(const node: TdomNode); begin FList.Add(node); end; procedure TdomXPathSnapshotResult.addSnapshotResult(const ir: TdomXPathSnapshotResult); // Merges two sorted snapshotResult objects. var i,x,y: integer; treePosition: TdomTreePosition; equivalentItems: TList; begin ir.axisType:= axisType; x:= 0; y:= 0; equivalentItems:= TList.create; try if axisType = XPATH_FORWARD_AXIS then begin while (x < snapshotLength) and (y < ir.snapshotLength) do begin treePosition:= snapshotItem(x).compareTreePosition(ir.snapshotItem(y)); if (Tree_Position_Same_Node in treePosition) then begin inc(y); end else if (Tree_Position_Equivalent in treePosition) then begin equivalentItems.Add(ir.snapshotItem(y)); inc(y); end else if (Tree_Position_Following in treePosition) then begin inc(x); for i:= pred(equivalentItems.Count) downto 0 do if (Tree_Position_Same_Node in snapshotItem(x).compareTreePosition(equivalentItems[i])) then equivalentItems.delete(i); end else if (Tree_Position_Disconnected in treePosition) then begin for i:= 0 to pred(equivalentItems.Count) do begin FList.insert(x,equivalentItems[i]); equivalentItems.delete(i); inc(x); end; inc(x); end else begin for i:= 0 to pred(equivalentItems.Count) do begin FList.insert(x,equivalentItems[i]); equivalentItems.delete(i); inc(x); end; FList.insert(x,ir.snapshotItem(y)); inc(x); inc(y); end; end; end else begin while (x < snapshotLength) and (y < ir.snapshotLength) do begin treePosition:= snapshotItem(x).compareTreePosition(ir.snapshotItem(y)); if (Tree_Position_Same_Node in treePosition) then begin inc(y); end else if (Tree_Position_Equivalent in treePosition) then begin equivalentItems.Add(ir.snapshotItem(y)); inc(y); end else if (Tree_Position_Preceding in treePosition) then begin inc(x); for i:= pred(equivalentItems.Count) downto 0 do if (Tree_Position_Same_Node in snapshotItem(x).compareTreePosition(equivalentItems[i])) then equivalentItems.delete(i); end else if (Tree_Position_Disconnected in treePosition) then begin for i:= 0 to pred(equivalentItems.Count) do begin FList.insert(x,equivalentItems[i]); equivalentItems.delete(i); inc(x); end; inc(x); end else begin for i:= 0 to pred(equivalentItems.Count) do begin FList.insert(x,equivalentItems[i]); equivalentItems.delete(i); inc(x); end; FList.insert(x,ir.snapshotItem(y)); inc(x); inc(y); end; end; end; inc(x); while (equivalentItems.Count > 0) and (x < snapshotLength) do begin if not (Tree_Position_Equivalent in snapshotItem(x).compareTreePosition(equivalentItems[0])) then begin for i:= 0 to pred(equivalentItems.Count) do begin FList.insert(x,equivalentItems[i]); equivalentItems.delete(i); end; end; for i:= pred(equivalentItems.Count) downto 0 do if (Tree_Position_Same_Node in snapshotItem(x).compareTreePosition(equivalentItems[i])) then equivalentItems.delete(i); inc(x); end; for i:= 0 to pred(equivalentItems.Count) do FList.add(equivalentItems[i]); if y < ir.snapshotLength then for i:= y to pred(ir.snapshotLength) do FList.add(ir.snapshotItem(i)); finally equivalentItems.free; end; end; procedure TdomXPathSnapshotResult.addSubtree(const node: TdomNode); // Adds 'node' and its subtree, excluding attributes. var n: TdomNode; bufferList: TList; i: integer; begin if axisType = XPATH_FORWARD_AXIS then begin if assigned(node) then begin with node.ownerDocument.createNodeIterator( node, [ ntElement_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node, ntProcessing_Instruction_Node, ntComment_Node, ntDocument_Node ], nil, false ) do begin n:= NextNode; while assigned(n) do begin FList.add(n); n:= NextNode; end; detach; end; node.ownerDocument.clearInvalidNodeIterators; end; end else begin if assigned(node) then begin bufferList:= TList.create; try with node.ownerDocument.createNodeIterator( node, [ ntElement_Node, ntText_Node, ntCDATA_Section_Node, ntEntity_Reference_Node, ntProcessing_Instruction_Node, ntComment_Node, ntDocument_Node ], nil, false ) do begin n:= NextNode; while assigned(n) do begin bufferList.add(n); n:= NextNode; end; detach; end; node.ownerDocument.clearInvalidNodeIterators; for i:= pred(bufferList.count) downto 0 do FList.add(bufferList[i]); finally bufferList.free; end; end; end; end; procedure TdomXPathSnapshotResult.delete(const index: integer); begin FList.delete(index); end; function TdomXPathSnapshotResult.getSnapshotLength: integer; begin result:= FList.count; end; procedure TdomXPathSnapshotResult.setAxisType(const value: TdomXPathAxisType); var item: Pointer; index1,index2,j: integer; begin If FAxisType <> value then begin FAxisType:= value; j:= pred(FList.Count); for index1:= 0 to ( j div 2) do begin index2:= j - index1; item:= FList.List^[index1]; FList.List^[index1]:= FList.List^[index2]; FList.List^[index2]:= item; end; end; end; function TdomXPathSnapshotResult.snapshotItem(const index: integer): TdomNode; begin if (index < 0) or (index >= FList.Count) then result:= nil else result:= TdomNode(FList.List^[index]); end; { TdomXPathBooleanResult } constructor TdomXPathBooleanResult.create(const aBooleanValue: boolean); begin FBooleanValue:= aBooleanValue; FResultType:= XPATH_BOOLEAN_TYPE; end; { TdomXPathNumberResult } constructor TdomXPathNumberResult.create(const aNumberValue: double); begin FNumberValue:= aNumberValue; FResultType:= XPATH_NUMBER_TYPE; end; { TdomXPathStringResult } constructor TdomXPathStringResult.create(const aStringValue: wideString); begin FStringValue:= aStringValue; FResultType:= XPATH_STRING_TYPE; end; end.