Archivado/Componentes.Terceros.RemObjects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
e4d0fcb01d
Componentes.Terceros.RemObj.../internal/5.0.23.613/1/RemObjects SDK for Delphi/Source/uROXDOM_2_3.pas
david 2824855ea7 - Modificación del paquete RemObjects_Core_D10 para que sea un paquete de runtime/designtime (antes era designtime sólo) 
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10
- Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10

git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
2007-09-10 14:06:19 +00:00

33166 lines
1.2 MiB
Raw Blame History

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('&#39;'); // Single quote
34: content.addWideString('&#34;'); // 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 copy(S,lengthS-2,3) <> '-->' 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 '<segment>/..' 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 '<segment>/..' 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('&amp;'); // Ampersand ('&')
34: content.addWideString('&quot;'); // Double quote ('"')
60: content.addWideString('&lt;'); // 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('&#60;'))
end else if (EntName='gt') then begin
Result:= Concat(Result,#62)
end else if (EntName='amp') then begin
Result:= Concat(Result,wideString('&#38;'))
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','&#38;#60;',60)
then result:= false;
if not testGtAposQuot('gt','&#62;',#62)
then result:= false;
if not testLtAmp('amp','&#38;#38;',38)
then result:= false;
if not testGtAposQuot('apos','&#39;',#39)
then result:= false;
if not testGtAposQuot('quot','&#34;',#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 <!ENTITY foo "<">), 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 '<?xml'?
declType:= DT_XML_OR_TEXT_DECLARATION;
if getNextWideChar2(ch,encodingType,loc) then begin
// Skip Whitespace:
while IsXmlWhiteSpace(ch) do
if not getNextWideChar2(ch,encodingType,loc) then begin
result:= false;
exit;
end;
// versionInfo:
if ( ord(ch) = $0076 ) then begin // 'v'
if getNextWideChar2(ch,encodingType,loc)
and ( ord(ch) = $0065 ) // 'e'
and getNextWideChar2(ch,encodingType,loc)
and ( ord(ch) = $0072 ) // 'r'
and getNextWideChar2(ch,encodingType,loc)
and ( ord(ch) = $0073 ) // 's'
and getNextWideChar2(ch,encodingType,loc)
and ( ord(ch) = $0069 ) // 'i'
and getNextWideChar2(ch,encodingType,loc)
and ( ord(ch) = $006f ) // 'o'
and getNextWideChar2(ch,encodingType,loc)
and ( ord(ch) = $006e ) // 'n'
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 version number:
if not getNextWideChar2(ch,encodingType,loc) then begin
result:= false;
exit;
end;
if isXmlVersionNumChar(ch) then begin
versionInfo:= ch;
end else begin
result:= false;
exit;
end;
if not getNextWideChar2(ch,encodingType,loc) then begin
result:= false;
exit;
end;
while isXmlVersionNumChar(ch) do begin
versionInfo:= concat(versionInfo,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 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,['<![CDATA[', data, ']]>']);
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,['<![CDATA[', data, ']]>']); 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,['<!--', data, '-->']);
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, ['<!DOCTYPE ', aname,' ']);
if result and ((pubId <> '') 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,['</', tagName, '>']);
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('&#38');//amp;'); // Ampersand ('&')
60: content.addWideString('&#60');//lt;'); // Less than ('<')
62: content.addWideString('&#62');//gt;'); // Greater than ('>')
13: content.addWideString('&#xD;'); // Carriage Return (CR)}
{ 38: content.addWideString('&#38;'); // Ampersand ('&')
60: content.addWideString('&#60;'); // Less than ('<')
62: content.addWideString('&#62;'); // Greater than ('>')
13: content.addWideString('&#xD;'); // Carriage Return (CR)}
38: content.addWideString('&amp;'); // Ampersand ('&')
60: content.addWideString('&lt;'); // Less than ('<')
62: content.addWideString('&gt;'); // Greater than ('>')
13: content.addWideString('&#xD;'); // 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,['<?', targ, '?>'])
else result:= writeWideStrings(sender,locator,['<?', targ, ' ', data, '?>']);
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,'<?xml version="1.0"')
else result:= writeWideStrings(sender,locator,['<?xml version="',version,'"']);
if result and (encName <> '')
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,['<![',includeStmt,'[',data,']]>']);
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'<!--', data, '-->']);
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'<?', targ, '?>'])
else result:= writeWideStrings(sender,locator,[#10'<?', targ, ' ', data, '?>']);
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'<!ELEMENT ', aname, #9, data, '>']);
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'<!ENTITY ', aname, #9]);
if result then begin
if ((pubId = '') and (sysId = '')) then begin
if Pos(DQ, entityValue) > 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'<!NOTATION ', aname, #9]);
if result then 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;
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'<!ENTITY % ', aname, #9]);
if result then begin
if ((pubId = '') and (sysId = '')) then begin
if Pos(DQ, entityValue) > 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'<!ATTLIST ', aname, #10]);
if result
then if assigned(nextHandler)
then result:= nextHandler.startAttListDeclaration(sender,locator,aname);
end;
function TXmlStreamBuilder.startExtDtd(const sender: TXmlCustomReader;
const locator: TdomLocator;
version,
encName: wideString): boolean;
const
BOM: wideString = #$feff; // UTF-16BE Byte order mark
var
newEncodingType: TdomEncodingType;
begin
if assigned(FOnstartExtDtd) then FOnstartExtDtd(sender,locator,version,encName);
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,'<?xml version="1.0"')
else result:= writeWideStrings(sender,locator,['<?xml version="',version,'"']);
if result and (encName <> '')
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, '&#60;');
Exit;
end else if (EntityName='gt') then begin
Result:= writeCharRef(locator, '&#62;');
Exit;
end else if (EntityName='amp') then begin
Result:= writeCharRef(locator, '&#38;');
Exit;
end else if (EntityName='apos') then begin
Result:= writeCharRef(locator, '&#39;');
Exit;
end else if (EntityName='quot') then begin
Result:= writeCharRef(locator, '&#34;');
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) <> '<!DOCTYPE')
or (content[length(content)] <> '>')
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 = '<?';
PIEND: wideString = '?>';
COMMENTSTART: wideString = '<!--';
CDATASTART: wideString = '<![CDATA[';
DOCTYPESTART: wideString = '<!DOCTYPE';
var
l,offset: integer;
str1: WideChar;
dummy,invalidStr,subEndMarker,SubStartMarker: wideString;
SingleQuoteOpen,DoubleQuoteOpen,BracketOpened: boolean;
pieceType: TdomPieceType;
content: TdomCustomStr;
begin
PieceType:= xmlUnknown;
subEndMarker:= '';
subStartMarker:= '';
SingleQuoteOpen:= false;
DoubleQuoteOpen:= false;
BracketOpened:= false;
result:= true;
content:= TdomCustomStr.create;
try
with inputSource do
writeStartDocument(locator,versionNumber,encodingName,standalone);
while InputSource.getNextWideChar(str1) do begin
if not result then break;
if not IsXmlChar(str1) then begin
content.addWideChar(str1);
inputsource.locator.setStartMark;
if str1 = #0
then invalidStr:= ''
else invalidStr:= wideString(str1);
result:= sendErrorNotification(ET_INVALID_CHARACTER,inputSource.locator,invalidStr);
end;
case PieceType of
xmlPCData: begin
if str1 = '<' then begin
result:= writePCDATA(inputSource.Locator,content.value);
content.reset;
PieceType:= xmlStartTag;
inputsource.locator.setStartMark;
end else
if str1 = '&' then begin
result:= writePCDATA(inputSource.Locator,content.value);
content.reset;
PieceType:= xmlEntityRef;
inputsource.locator.setStartMark;
end;
content.AddWideChar(Str1);
end;
xmlEntityRef: begin
content.AddWideChar(str1);
if str1 = ';' then begin
if content[2] = NUMBERSIGN
then result:= writeCharRef(inputSource.Locator,content.value)
else result:= writeEntityRef(inputSource.Locator,content.value);
content.reset;
PieceType:= xmlUnknown;
end;
end;
xmlStartTag: begin
content.AddWideChar(str1);
case content.length of
2: if content.startsWith(PISTART) then PieceType:= xmlProcessingInstruction;
4: if content.startsWith(COMMENTSTART) then PieceType:= xmlComment;
9: if content.startsWith(CDATASTART) then begin
PieceType:= xmlCDATA;
end else
if content.startsWith(DOCTYPESTART) then begin
PieceType:= xmlDoctype;
subEndMarker:= '';
subStartMarker:= '';
BracketOpened:= false;
end;
end;
// Count quotation marks:
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 else if str1 = '>' then begin
if (not DoubleQuoteOpen) and (not SingleQuoteOpen) then begin
if content[2] = SOLIDUS then begin
l:= content.length;
offset:= 3;
// eliminate white-space after tag name:
while (l-offset > 0) and IsXmlWhiteSpace(content[l-offset+2]) do
inc(offset);
result:= writeEndElement(inputSource.Locator,copy(content.value,3,l-offset))
end else begin if content[content.length-1] = SOLIDUS
then result:= writeEmptyElement(inputSource.Locator,copy(content.value,2,content.length-3))
else result:= writeStartElement(inputSource.Locator,copy(content.value,2,content.length-2),dummy);
end;
content.reset;
PieceType:= xmlUnknown;
end;
end;
end;
xmlProcessingInstruction: begin
content.addWideChar(str1);
if str1 = '>' then
if content[content.length-1] = QM then begin
result:= writeProcessingInstruction(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:= writeComment(inputSource.Locator,copy(content.value,5,content.length-7));
content.reset;
PieceType:= xmlUnknown;
end;
end;
xmlCDATA: begin
content.AddWideChar(str1);
if str1 = '>' then
if content[content.length-1] = ']' then
if content[content.length-2] = ']' then begin
result:= writeCDATA(inputSource.Locator,copy(content.value,10,content.length-12));
content.reset;
PieceType:= xmlUnknown;
end;
end;
xmlDoctype: begin
content.AddWideChar(str1);
if (SubEndMarker = '') then begin
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 BracketOpened then begin
if not (SingleQuoteOpen or DoubleQuoteOpen) then begin
if str1 = '<' then begin
SubStartMarker:= '<';
end else if (str1 = '!') and (SubStartMarker = '<') then begin
SubStartMarker:= '<!';
end else if (str1 = QM) and (SubStartMarker = '<') then begin
SubStartMarker:= '';
SubEndMarker:= PIEND;
end else if (str1 = '-') and (SubStartMarker = '<!')then begin
SubStartMarker:= '<!-';
end else if (str1 = '-') and (SubStartMarker = '<!-')then begin
SubStartMarker:= '';
SubEndMarker:= '-->';
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;
if (copy(content,length(content)-2,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) <> '<!ENTITY')
or (content[length(content)] <> '>')
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) <> '<!ELEMENT')
or (content[length(content)] <> '>')
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) <> '<!ATTLIST')
or (Content[length(Content)] <> '>')
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) <> '<!NOTATION')
or (Content[length(Content)] <> '>')
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 = '<?';
TEXTDECLSTART: wideString = '<?xml';
CONTSECTSTART: wideString = '<![';
COMMENTSTART: wideString = '<!--';
ENTITYSTART: wideString = '<!ENTITY';
ELEMENTSTART: wideString = '<!ELEMENT';
ATTLISTSTART: wideString = '<!ATTLIST';
NOTATIONSTART: wideString = '<!NOTATION';
var
str1: WideChar;
entityDeclValue,dummy,invalidStr: wideString;
SingleQuoteOpen,DoubleQuoteOpen: boolean;
commentActive,includeStatementFinished: boolean;
i: integer;
PieceType: TdomPieceType;
content: TdomCustomStr;
condSectCounter: longint;
begin
PieceType:= xmlUnknown;
SingleQuoteOpen:= false;
DoubleQuoteOpen:= false;
commentActive:= false;
includeStatementFinished:= false;
condSectCounter:= 0;
result:= true;
content:= TdomCustomStr.create;
try
with inputSource do
writeStartExtDtd(locator,versionNumber,encodingName);
while InputSource.getNextWideChar(str1) do begin
if not result then break;
if not IsXmlChar(str1) then begin
content.addWideChar(str1);
inputsource.locator.setStartMark;
if str1 = #0
then invalidStr:= ''
else invalidStr:= wideString(str1);
result:= sendErrorNotification(ET_INVALID_CHARACTER,inputSource.locator,invalidStr);
end;
case PieceType of
xmlParameterEntityRef: begin
content.addWideChar(str1);
if str1 = ';' then begin
result:= WriteParameterEntityRef(inputSource.Locator,content.value);
content.reset;
PieceType:= xmlUnknown;
end;
end;
xmlStartTag: begin
content.addWideChar(str1);
case content.length of
2: if content.startsWith(PISTART) then PieceType:= xmlProcessingInstruction;
3: if content.startsWith(CONTSECTSTART) then begin
PieceType:= xmlCondSection;
condSectCounter:= 1;
commentActive:= false;
includeStatementFinished:= false;
end;
4: if content.startsWith(COMMENTSTART) then PieceType:= xmlComment;
8: if content.startsWith(ENTITYSTART) then PieceType:= xmlEntityDecl;
9: if content.startsWith(ELEMENTSTART) then PieceType:= xmlElementDecl
else if content.startsWith(ATTLISTSTART) then PieceType:= xmlAttributeDecl;
10: if content.startsWith(NOTATIONSTART) then PieceType:= xmlNotationDecl;
end;
end;
xmlProcessingInstruction: begin
content.addWideChar(str1);
if str1 = '>' 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 = '<?';
COMMENTSTART: wideString = '<!--';
ENTITYSTART: wideString = '<!ENTITY';
ELEMENTSTART: wideString = '<!ELEMENT';
ATTLISTSTART: wideString = '<!ATTLIST';
NOTATIONSTART: wideString = '<!NOTATION';
var
str1: WideChar;
SingleQuoteOpen,DoubleQuoteOpen: boolean;
PieceType: TdomPieceType;
content: TdomCustomStr;
invalidStr: wideString;
begin
PieceType:= xmlUnknown;
SingleQuoteOpen:= false;
DoubleQuoteOpen:= false;
result:= true;
content:= TdomCustomStr.create;
try
writeStartIntDtd(inputSource.locator);
while InputSource.getNextWideChar(str1) do begin
if not result then break;
if not IsXmlChar(str1) then begin
content.addWideChar(str1);
inputsource.locator.setStartMark;
if str1 = #0
then invalidStr:= ''
else invalidStr:= wideString(str1);
result:= sendErrorNotification(ET_INVALID_CHARACTER,inputSource.locator,invalidStr);
end;
case PieceType of
xmlParameterEntityRef: begin
content.addWideChar(str1);
if str1 = ';' then begin
result:= WriteParameterEntityRef(inputSource.Locator,content.value);
content.reset;
PieceType:= xmlUnknown;
end;
end;
xmlStartTag: begin
content.addWideChar(str1);
case content.length of
2: if content.startsWith(PISTART) then PieceType:= xmlProcessingInstruction;
4: if content.startsWith(COMMENTSTART) then PieceType:= xmlComment;
8: if content.startsWith(ENTITYSTART) then PieceType:= xmlEntityDecl;
9: if content.startsWith(ELEMENTSTART) then PieceType:= xmlElementDecl
else if content.startsWith(ATTLISTSTART) then PieceType:= xmlAttributeDecl;
10: if content.startsWith(NOTATIONSTART) then PieceType:= xmlNotationDecl;
end;
end;
xmlProcessingInstruction: begin
content.addWideChar(str1);
if str1 = '>' 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,'&#60;');
if not result then break;
content.reset;
end;
38: begin // AMP
result:= WritePCDATA(locator,content.value);
if not result then break;
result:= WriteCharRef(locator,'&#38;');
if not result then break;
content.reset;
end;}
60: begin // LT
result:= WritePCDATA(locator,content.value);
if not result then break;
result:= WriteCharRef(locator,'&lt;');
if not result then break;
content.reset;
end;
38: begin // AMP
result:= WritePCDATA(locator,content.value);
if not result then break;
result:= WriteCharRef(locator,'&amp;');
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.
Reference in New Issue View Git Blame Copy Permalink