From 6d0a072f8d81d33507cdb727b99d4d6b2013d5c7 Mon Sep 17 00:00:00 2001 From: vlasov Date: Fri, 31 May 2013 16:03:11 +0600 Subject: [PATCH] start working on xe compatibility --- SimpleXML.pas | 1718 +++++++++++++++++++++++++++---------------------- 1 file changed, 943 insertions(+), 775 deletions(-) diff --git a/SimpleXML.pas b/SimpleXML.pas index 6e8a4b9..bf234da 100644 --- a/SimpleXML.pas +++ b/SimpleXML.pas @@ -1,26 +1,3 @@ -{************************************************************ - SimpleXML - Библиотека для синтаксического разбора текстов XML - и преобразования в иерархию XML-объектов. - И наоборот: можно сформировать иерархию XML-объектов, и - уже из нее получить текст XML. - Достойная замена для MSXML. При использовании Ansi-строк - работает быстрее и кушает меньше памяти. - - (с) Авторские права 2002,2003 Михаил Власов. - Библиотека бесплатная и может быть использована по любому назначению. - Разрешается внесение любых изменений и использование измененных - библиотек без ограничений. - Единственное требование: Данный текст должен присутствовать - без изменений во всех модификациях библиотеки. - - Все пожелания приветствую по адресу misha@integro.ru - Так же рекомендую посетить мою страничку: http://mv.rb.ru - К сожалению, сайт автора канул в небытие. Исходники размещаю у себя - на сайте http://www.kraeg.ru (Kirill Krasnov) - Желаю приятного программирования, Михаил Власов. - - Текущая версия: devel -*************************************************************} unit SimpleXML; interface @@ -29,14 +6,10 @@ uses Windows, SysUtils, Classes; const - BinXmlSignatureSize = Length('< binary-xml >'); - BinXmlSignature: String = '< binary-xml >'; - BINXML_USE_WIDE_CHARS = 1; - BINXML_COMPRESSED = 2; XSTR_NULL = '{{null}}'; - + NODE_INVALID = $00000000; NODE_ELEMENT = $00000001; NODE_ATTRIBUTE = $00000002; @@ -52,21 +25,6 @@ const NODE_NOTATION = $0000000C; type - // TXmlString - тип строковых переменных, используемых в SimpleXML. - // Может быть String или WideString. - - { $DEFINE XML_WIDE_CHARS} - - {$IFDEF XML_WIDE_CHARS} - PXmlChar = PWideChar; - TXmlChar = WideChar; - TXmlString = WideString; - {$ELSE} - PXmlChar = PChar; - TXmlChar = Char; - TXmlString = String; - {$ENDIF} - IXmlDocument = interface; IXmlElement = interface; IXmlText = interface; @@ -86,10 +44,10 @@ type // названий тэгов и атрибутов. IXmlNameTable = interface(IXmlBase) // GetID - возвращает числовой идентификатор указанной строки. - function GetID(const aName: TXmlString): Integer; + function GetID(const aName: String): Integer; // GetID - возвращает строку, соответствующую указанному числовому // идентификатору. - function GetName(anID: Integer): TXmlString; + function GetName(anID: Integer): String; end; IXmlNode = interface; @@ -104,7 +62,7 @@ type // Get_Item - получить узел по индексу function Get_Item(anIndex: Integer): IXmlNode; // Get_XML - возвращает представление элементов списка в формате XML - function Get_XML: TXmlString; + function Get_XML: String; procedure SortElements(aCompare: TXmlCompareNodes); function IndexOf(const aNode: IXmlNode): Integer; @@ -116,7 +74,7 @@ type property Count: Integer read Get_Count; property Item[anIndex: Integer]: IXmlNode read Get_Item; default; - property XML: TXmlString read Get_XML; + property XML: String read Get_XML; end; // IXmlNode - узел XML-дерева @@ -128,15 +86,15 @@ type function Get_NameTable: IXmlNameTable; // Get_NodeName - возвращает название узла. Интерпретация названия узла // зависит от его типа - function Get_NodeName: TXmlString; + function Get_NodeName: String; // Get_NodeNameID - возвращает код названия узла function Get_NodeNameID: Integer; // Get_NodeType - возвращает тип узла function Get_NodeType: Integer; // Get_Text - возвращает текст узла - function Get_Text: TXmlString; + function Get_Text: String; // Set_Text - изменяет текст узла - procedure Set_Text(const aValue: TXmlString); + procedure Set_Text(const aValue: String); // Get_DataType - возаращает тип данных узла в терминах вариантов function Get_DataType: Integer; // Get_TypedValue - возвращает @@ -145,7 +103,7 @@ type procedure Set_TypedValue(const aValue: Variant); // Get_XML - возвращает представление узла и всех вложенных узлов // в формате XML. - function Get_XML: TXmlString; + function Get_XML: String; // CloneNode - создает точную копию данного узла // Если задан признак aDeep, то создастся копия @@ -174,54 +132,54 @@ type // AppendElement - создает элемент и добавляет его в конец списка // в конец списка дочерних объектов function AppendElement(aNameID: Integer): IXmlElement; overload; - function AppendElement(const aName: TxmlString): IXmlElement; overload; + function AppendElement(const aName: String): IXmlElement; overload; // AppendText - создает текстовый узел и добавляет его // в конец списка дочерних объектов - function AppendText(const aData: TXmlString): IXmlText; + function AppendText(const aData: String): IXmlText; // AppendCDATA - создает секцию CDATA и добавляет ее // в конец списка дочерних объектов - function AppendCDATA(const aData: TXmlString): IXmlCDATASection; + function AppendCDATA(const aData: String): IXmlCDATASection; // AppendComment - создает комментарий и добавляет его // в конец списка дочерних объектов - function AppendComment(const aData: TXmlString): IXmlComment; + function AppendComment(const aData: String): IXmlComment; // AppendProcessingInstruction - создает инструкцию и добавляет её // в конец списка дочерних объектов function AppendProcessingInstruction(aTargetID: Integer; - const aData: TXmlString): IXmlProcessingInstruction; overload; - function AppendProcessingInstruction(const aTarget: TXmlString; - const aData: TXmlString): IXmlProcessingInstruction; overload; + const aData: String): IXmlProcessingInstruction; overload; + function AppendProcessingInstruction(const aTarget: String; + const aData: String): IXmlProcessingInstruction; overload; // GetChildText - возвращает значение дочернего узла // SetChildText - добавляет или изменяет значение дочернего узла - function GetChildText(const aName: TXmlString; const aDefault: TXmlString = ''): TXmlString; overload; - function GetChildText(aNameID: Integer; const aDefault: TXmlString = ''): TXmlString; overload; - procedure SetChildText(const aName, aValue: TXmlString); overload; - procedure SetChildText(aNameID: Integer; const aValue: TXmlString); overload; + function GetChildText(const aName: String; const aDefault: String = ''): String; overload; + function GetChildText(aNameID: Integer; const aDefault: String = ''): String; overload; + procedure SetChildText(const aName, aValue: String); overload; + procedure SetChildText(aNameID: Integer; const aValue: String); overload; // NeedChild - возвращает дочерний узел с указанным именем. // Если узел не найден, то генерируется исключение function NeedChild(aNameID: Integer): IXmlNode; overload; - function NeedChild(const aName: TXmlString): IXmlNode; overload; + function NeedChild(const aName: String): IXmlNode; overload; // EnsureChild - возвращает дочерний узел с указанным именем. // Если узел не найден, то он будет создан function EnsureChild(aNameID: Integer): IXmlNode; overload; - function EnsureChild(const aName: TXmlString): IXmlNode; overload; + function EnsureChild(const aName: String): IXmlNode; overload; // RemoveAllChilds - удаляет все дочерние узлы procedure RemoveAllChilds; // SelectNodes - производит выборку узлов, удовлетворяющих // указанным критериям - function SelectNodes(const anExpression: TXmlString): IXmlNodeList; overload; + function SelectNodes(const anExpression: String): IXmlNodeList; overload; function SelectNodes(aNodeNameID: Integer): IXmlNodeList; overload; // SelectSingleNode - производит поиск первого узла, удовлетворяющего // указанным критериям - function SelectSingleNode(const anExpression: TXmlString): IXmlNode; + function SelectSingleNode(const anExpression: String): IXmlNode; // FindElement - производит поиск первого узла, удовлетворяющего // указанным критериям function FindElement(const anElementName, anAttrName: String; const anAttrValue: Variant): IXmlElement; @@ -232,20 +190,20 @@ type // Get_AttrNameID - возвращает код названия атрибута function Get_AttrNameID(anIndex: Integer): Integer; // Get_AttrName - возвращает название атрибута - function Get_AttrName(anIndex: Integer): TXmlString; + function Get_AttrName(anIndex: Integer): String; // RemoveAttr - удаляет атрибут - procedure RemoveAttr(const aName: TXmlString); overload; + procedure RemoveAttr(const aName: String); overload; procedure RemoveAttr(aNameID: Integer); overload; // RemoveAllAttrs - удаляет все атрибуты procedure RemoveAllAttrs; // AttrExists - проверяет, задан ли указанный атрибут. function AttrExists(aNameID: Integer): Boolean; overload; - function AttrExists(const aName: TXmlString): Boolean; overload; + function AttrExists(const aName: String): Boolean; overload; // GetAttrType - возаращает тип данных атрибута в терминах вариантов function GetAttrType(aNameID: Integer): Integer; overload; - function GetAttrType(const aName: TXmlString): Integer; overload; + function GetAttrType(const aName: String): Integer; overload; // GetAttrType - возвращает тип атрибута // Result @@ -253,61 +211,66 @@ type // Если атрибут не задан, то возвращается значение по умолчанию // SetAttr - изменяет или добавляет указанный атрибут function GetVarAttr(aNameID: Integer; const aDefault: Variant): Variant; overload; - function GetVarAttr(const aName: TXmlString; const aDefault: Variant): Variant; overload; + function GetVarAttr(const aName: String; const aDefault: Variant): Variant; overload; procedure SetVarAttr(aNameID: Integer; const aValue: Variant); overload; - procedure SetVarAttr(const aName: TXmlString; aValue: Variant); overload; + procedure SetVarAttr(const aName: String; aValue: Variant); overload; function NeedVarAttr(aNameID: Integer): Variant; overload; - function NeedVarAttr(const aName: TXmlString): Variant; overload; + function NeedVarAttr(const aName: String): Variant; overload; // NeedAttr - возвращает строковое значение указанного атрибута. // Если атрибут не задан, то генерируется исключение - function NeedAttr(aNameID: Integer): TXmlString; overload; - function NeedAttr(const aName: TXmlString): TXmlString; overload; + function NeedAttr(aNameID: Integer): String; overload; + function NeedAttr(const aName: String): String; overload; // GetAttr - возвращает строковое значение указанного атрибута. // Если атрибут не задан, то возвращается значение по умолчанию // SetAttr - изменяет или добавляет указанный атрибут - function GetAttr(aNameID: Integer; const aDefault: TXmlString = ''): TXmlString; overload; - function GetAttr(const aName: TXmlString; const aDefault: TXmlString = ''): TXmlString; overload; - procedure SetAttr(aNameID: Integer; const aValue: TXmlString); overload; - procedure SetAttr(const aName, aValue: TXmlString); overload; + function GetAttr(aNameID: Integer; const aDefault: String = ''): String; overload; + function GetAttr(const aName: String; const aDefault: String = ''): String; overload; + procedure SetAttr(aNameID: Integer; const aValue: String); overload; + procedure SetAttr(const aName, aValue: String); overload; // GetBoolAttr - возвращает целочисленное значение указанного атрибута // SetBoolAttr - изменяет или добавляет указанный атрибут целочисленным // значением function GetBoolAttr(aNameID: Integer; aDefault: Boolean = False): Boolean; overload; - function GetBoolAttr(const aName: TXmlString; aDefault: Boolean = False): Boolean; overload; + function GetBoolAttr(const aName: String; aDefault: Boolean = False): Boolean; overload; procedure SetBoolAttr(aNameID: Integer; aValue: Boolean = False); overload; - procedure SetBoolAttr(const aName: TXmlString; aValue: Boolean); overload; + procedure SetBoolAttr(const aName: String; aValue: Boolean); overload; // GetIntAttr - возвращает целочисленное значение указанного атрибута // SetIntAttr - изменяет или добавляет указанный атрибут целочисленным // значением function GetIntAttr(aNameID: Integer; aDefault: Integer = 0): Integer; overload; - function GetIntAttr(const aName: TXmlString; aDefault: Integer = 0): Integer; overload; + function GetIntAttr(const aName: String; aDefault: Integer = 0): Integer; overload; + function NeedIntAttr(const aName: String): Integer; overload; + function NeedIntAttr(aNameID: Integer): Integer; overload; + procedure SetIntAttr(aNameID: Integer; aValue: Integer); overload; - procedure SetIntAttr(const aName: TXmlString; aValue: Integer); overload; + procedure SetIntAttr(const aName: String; aValue: Integer); overload; + + // GetDateTimeAttr - возвращает целочисленное значение указанного атрибута // SetDateTimeAttr - изменяет или добавляет указанный атрибут целочисленным // значением function GetDateTimeAttr(aNameID: Integer; aDefault: TDateTime = 0): TDateTime; overload; - function GetDateTimeAttr(const aName: TXmlString; aDefault: TDateTime = 0): TDateTime; overload; + function GetDateTimeAttr(const aName: String; aDefault: TDateTime = 0): TDateTime; overload; procedure SetDateTimeAttr(aNameID: Integer; aValue: TDateTime); overload; - procedure SetDateTimeAttr(const aName: TXmlString; aValue: TDateTime); overload; + procedure SetDateTimeAttr(const aName: String; aValue: TDateTime); overload; // GetFloatAttr - возвращает значение указанного атрибута в виде // вещественного числа // SetFloatAttr - изменяет или добавляет указанный атрибут вещественным // значением function GetFloatAttr(aNameID: Integer; aDefault: Double = 0): Double; overload; - function GetFloatAttr(const aName: TXmlString; aDefault: Double = 0): Double; overload; + function GetFloatAttr(const aName: String; aDefault: Double = 0): Double; overload; function NeedFloatAttr(aNameID: Integer): Double; overload; - function NeedFloatAttr(const aName: TXmlString): Double; overload; + function NeedFloatAttr(const aName: String): Double; overload; procedure SetFloatAttr(aNameID: Integer; aValue: Double); overload; - procedure SetFloatAttr(const aName: TXmlString; aValue: Double); overload; + procedure SetFloatAttr(const aName: String; aValue: Double); overload; // GetHexAttr - получение значения указанного атрибута в целочисленном виде. // Строковое значение атрибута преобразуется в целое число. Исходная @@ -321,46 +284,46 @@ type // генерируется исключение. // Если атрибут не был задан, до он будет добавлен. // Если был задан, то будет изменен. - function GetHexAttr(const aName: TXmlString; aDefault: Integer = 0): Integer; overload; + function GetHexAttr(const aName: String; aDefault: Integer = 0): Integer; overload; function GetHexAttr(aNameID: Integer; aDefault: Integer = 0): Integer; overload; - procedure SetHexAttr(const aName: TXmlString; aValue: Integer; aDigits: Integer = 8); overload; + procedure SetHexAttr(const aName: String; aValue: Integer; aDigits: Integer = 8); overload; procedure SetHexAttr(aNameID: Integer; aValue: Integer; aDigits: Integer = 8); overload; // GetEnumAttr - ищет значение атрибута в указанном списке строк и // возвращает индекс найденной строки. Если атрибут задан но не найден // в списке, то генерируется исключение. // Если атрибут не задан, возвращается значение параметра aDefault. - function GetEnumAttr(const aName: TXmlString; - const aValues: array of TXmlString; aDefault: Integer = 0): Integer; overload; + function GetEnumAttr(const aName: String; + const aValues: array of String; aDefault: Integer = 0): Integer; overload; function GetEnumAttr(aNameID: Integer; - const aValues: array of TXmlString; aDefault: Integer = 0): Integer; overload; + const aValues: array of String; aDefault: Integer = 0): Integer; overload; - function NeedEnumAttr(const aName: TXmlString; - const aValues: array of TXmlString): Integer; overload; + function NeedEnumAttr(const aName: String; + const aValues: array of String): Integer; overload; function NeedEnumAttr(aNameID: Integer; - const aValues: array of TXmlString): Integer; overload; + const aValues: array of String): Integer; overload; // ReplaceTextByCDATASection - удаляет все текстовые элементы и добавляет // одну секцию CDATA, содержащую указанный текст - procedure ReplaceTextByCDATASection(const aText: TXmlString); + procedure ReplaceTextByCDATASection(const aText: String); - // ReplaceTextByBynaryData - удаляет все текстовые элементы и добавляет + // ReplaceTextByBinaryData - удаляет все текстовые элементы и добавляет // один текстовый элемент, содержащий указанные двоичные данные // в формате "base64". // Если параметр aMaxLineLength не равен нулю, то производится разбивка // полученой строки на строки длиной aMaxLineLength. // Строки разделяются парой символов #13#10 (CR,LF). // После последней строки указанные символы не вставляются. - procedure ReplaceTextByBynaryData(const aData; aSize: Integer; + procedure ReplaceTextByBinaryData(const aData; aSize: Integer; aMaxLineLength: Integer); - // GetTextAsBynaryData - cобирает все текстовые элементы в одну строку и + // GetTextAsBinaryData - cобирает все текстовые элементы в одну строку и // производит преобразование из формата "base64" в двоичные данные. // При преобразовании игнорируются все пробельные символы (с кодом <= ' '), // содержащиеся в исходной строке. - function GetTextAsBynaryData: String; + function GetTextAsBinaryData: RawByteString; - function GetOwnText: TXmlString; + function GetOwnText: String; function Get_Values(const aName: String): Variant; procedure Set_Values(const aName: String; const aValue: Variant); @@ -373,7 +336,7 @@ type property SourceLine: Integer read Get_SourceLine; property SourceCol: Integer read Get_SourceCol; - property NodeName: TXmlString read Get_NodeName; + property NodeName: String read Get_NodeName; property NodeNameID: Integer read Get_NodeNameID; property NodeType: Integer read Get_NodeType; property ParentNode: IXmlNode read Get_ParentNode; @@ -382,12 +345,12 @@ type property NameTable: IXmlNameTable read Get_NameTable; property ChildNodes: IXmlNodeList read Get_ChildNodes; property AttrCount: Integer read Get_AttrCount; - property AttrNames[anIndex: Integer]: TXmlString read Get_AttrName; + property AttrNames[anIndex: Integer]: String read Get_AttrName; property AttrNameIDs[anIndex: Integer]: Integer read Get_AttrNameID; - property Text: TXmlString read Get_Text write Set_Text; + property Text: String read Get_Text write Set_Text; property DataType: Integer read Get_DataType; property TypedValue: Variant read Get_TypedValue write Set_TypedValue; - property XML: TXmlString read Get_XML; + property Xml: String read Get_Xml; property Values[const aName: String]: Variant read Get_Values write Set_Values; default; end; @@ -407,46 +370,50 @@ type end; IXmlProcessingInstruction = interface(IXmlNode) + function Get_Target: String; + + property Target: String read Get_Target; end; IXmlDocument = interface(IXmlNode) function Get_DocumentElement: IXmlElement; - function Get_BinaryXML: String; + function Get_BinaryXML: RawByteString; function Get_PreserveWhiteSpace: Boolean; procedure Set_PreserveWhiteSpace(aValue: Boolean); - function NewDocument(const aVersion, anEncoding: TXmlString; + function NewDocument(const aVersion, anEncoding: String; aRootElementNameID: Integer): IXmlElement; overload; function NewDocument(const aVersion, anEncoding, - aRootElementName: TXmlString): IXmlElement; overload; + aRootElementName: String): IXmlElement; overload; function CreateElement(aNameID: Integer): IXmlElement; overload; - function CreateElement(const aName: TXmlString): IXmlElement; overload; - function CreateText(const aData: TXmlString): IXmlText; - function CreateCDATASection(const aData: TXmlString): IXmlCDATASection; - function CreateComment(const aData: TXmlString): IXmlComment; + function CreateElement(const aName: String): IXmlElement; overload; + function CreateText(const aData: String): IXmlText; + function CreateCDATASection(const aData: String): IXmlCDATASection; + function CreateComment(const aData: String): IXmlComment; function CreateProcessingInstruction(const aTarget, - aData: TXmlString): IXmlProcessingInstruction; overload; + aData: String): IXmlProcessingInstruction; overload; function CreateProcessingInstruction(aTargetID: Integer; - const aData: TXmlString): IXmlProcessingInstruction; overload; + const aData: String): IXmlProcessingInstruction; overload; - procedure LoadXML(const anXml: TXmlString); - procedure LoadBinaryXML(const anXml: String); + procedure LoadXML(const anXml: String); overload; + procedure LoadXML(const anXml: RawByteString); overload; + procedure LoadBinaryXML(const anXml: RawByteString); procedure Load(aStream: TStream); overload; - procedure Load(const aFileName: TXmlString); overload; + procedure Load(const aFileName: String); overload; procedure LoadResource(aType, aName: PChar); procedure Save(aStream: TStream); overload; - procedure Save(const aFileName: TXmlString); overload; + procedure Save(const aFileName: String); overload; procedure SaveBinary(aStream: TStream; anOptions: LongWord = 0); overload; - procedure SaveBinary(const aFileName: TXmlString; anOptions: LongWord = 0); overload; + procedure SaveBinary(const aFileName: String; anOptions: LongWord = 0); overload; property PreserveWhiteSpace: Boolean read Get_PreserveWhiteSpace write Set_PreserveWhiteSpace; property DocumentElement: IXmlElement read Get_DocumentElement; - property BinaryXML: String read Get_BinaryXML; + property BinaryXML: RawByteString read Get_BinaryXML; end; function CreateNameTable(aHashTableSize: Integer = 4096): IXmlNameTable; @@ -456,16 +423,15 @@ function CreateXmlDocument( const anEncoding: String = ''; // SimpleXmlDefaultEncoding const aNames: IXmlNameTable = nil): IXmlDocument; -function CreateXmlElement(const aName: TXmlString; const aNameTable: IXmlNameTable = nil): IXmlElement; +function CreateXmlElement(const aName: String; const aNameTable: IXmlNameTable = nil): IXmlElement; function CreateXmlNodeList: IXmlNodeList; -function LoadXmlDocumentFromXML(const anXml: TXmlString): IXmlDocument; -function LoadXmlDocumentFromBinaryXML(const anXml: String): IXmlDocument; +function LoadXmlDocumentFromXml(const anXml: String): IXmlDocument; +function LoadXmlDocumentFromBinaryXML(const aBinaryXml: RawByteString): IXmlDocument; function LoadXmlDocument(aStream: TStream): IXmlDocument; overload; -function LoadXmlDocument(const aFileName: TXmlString): IXmlDocument; overload; +function LoadXmlDocument(const aFileName: String): IXmlDocument; overload; function LoadXmlDocument(aResType, aResName: PChar): IXmlDocument; overload; - var DefaultNameTable: IXmlNameTable = nil; DefaultPreserveWhiteSpace: Boolean = False; @@ -500,36 +466,41 @@ resourcestring SSimpleXmlError23 = 'Ошибка чтения данных.'; SSimpleXmlError24 = 'Ошибка чтения значения: некорректный тип.'; SSimpleXmlError25 = 'Ошибка записи значения: некорректный тип.'; - SSimpleXmlError26 = '%s (%s)'; - SSimpleXmlError27 = 'Ошибка установки значения атрибута: не задано имя.'; + SSimpleXmlError26 = '%s (файл: "%s")'; + SSimpleXmlError27 = 'Ошибка установки значения атрибута: не задано имя.'; -function XSTRToFloat(s: TXmlString): Double; -function FloatToXSTR(v: Double): TXmlString; -function DateTimeToXSTR(v: TDateTime): TXmlString; -function VarToXSTR(const v: TVarData): TXmlString; +function XSTRToFloat(s: String): Double; +function FloatToXSTR(v: Double): String; +function DateTimeToXSTR(v: TDateTime): String; +function VarToXSTR(const v: TVarData): String; -function TextToXML(const aText: TXmlString): TXmlString; +function TextToXML(const aText: String): String; function BinToBase64(const aBin; aSize, aMaxLineLength: Integer): String; -function Base64ToBin(const aBase64: String): String; -function IsXmlDataString(const aData: String): Boolean; -function XmlIsInBinaryFormat(const aData: String): Boolean; -procedure PrepareToSaveXml(var anElem: IXmlElement; const aChildName: String); -function PrepareToLoadXml(var anElem: IXmlElement; const aChildName: String): Boolean; +function Base64ToBin(const aBase64: String): RawByteString; + +function IsXmlDataString(const aData: RawByteString): Boolean; +function XmlIsInBinaryFormat(const aData: RawByteString): Boolean; + +function AppendChildNodeFromXml(const aParentNode: IXmlNode; const anXml: String): IXmlNode; implementation uses Variants, DateUtils; +const + BinXmlSignatureSize = Length('< binary-xml >'); + BinXmlSignature: RawByteString = '< binary-xml >'; + type TStringBuilder = object private - FData: TXmlString; + FData: String; FLength: Integer; public procedure Init; - procedure Add(const s: TXmlString); - procedure GetString(var aString: TXmlString); + procedure Add(const s: String); + procedure GetString(var aString: String); end; { TStringBuilder } @@ -546,84 +517,108 @@ var aNewLength: Integer; begin anAddLength := Length(s); - if anAddLength = 0 then + if anAddLength = 0 then begin Exit; + end; aNewLength := FLength + anAddLength; - if aNewLength > Length(FData) then - if aNewLength > 64 then + if aNewLength > Length(FData) then begin + if aNewLength > 64 then begin SetLength(FData, aNewLength + aNewLength div 4) - else if aNewLength > 8 then + end + else if aNewLength > 8 then begin SetLength(FData, aNewLength + 16) - else + end + else begin SetLength(FData, aNewLength + 4); - Move(s[1], FData[FLength + 1], anAddLength*sizeof(TXmlChar)); + end + end; + Move(s[1], FData[FLength + 1], anAddLength*sizeof(Char)); FLength := aNewLength; end; procedure TStringBuilder.GetString(var aString: String); begin - SetLength(aString, FLength); - if FLength > 0 then - Move(FData[1], aString[1], FLength*sizeof(TXmlChar)); + aString := Copy(FData, 1, FLength); end; -function TextToXML(const aText: TXmlString): TXmlString; +procedure CopyChars(const aFrom: String; var aTo: String; var aPos: Integer); +begin + Move(aFrom[1], aTo[aPos], Length(aFrom)*sizeof(Char)); + Inc(aPos, Length(aFrom)); +end; + +function TextToXML(const aText: String): String; var i, j: Integer; begin j := 0; - for i := 1 to Length(aText) do + for i := 1 to Length(aText) do begin case aText[i] of '<', '>': Inc(j, 4); '&': Inc(j, 5); '"': Inc(j, 6); - else + else begin Inc(j); + end end; - if j = Length(aText) then + end; + + if j = Length(aText) then begin Result := aText + end else begin SetLength(Result, j); j := 1; - for i := 1 to Length(aText) do + for i := 1 to Length(aText) do begin case aText[i] of - '<': begin Move(PChar('<')^, Result[j], 4); Inc(j, 4) end; - '>': begin Move(PChar('>')^, Result[j], 4); Inc(j, 4) end; - '&': begin Move(PChar('&')^, Result[j], 5); Inc(j, 5) end; - '"': begin Move(PChar('"')^, Result[j], 6); Inc(j, 6) end; + '<': begin CopyChars('<', Result, j) end; + '>': begin CopyChars('>', Result, j) end; + '&': begin CopyChars('&', Result, j) end; + '"': begin CopyChars('"', Result, j) end; else begin Result[j] := aText[i]; Inc(j) end; end; + end; end; end; -function XSTRToFloat(s: TXmlString): Double; +function XSTRToFloat(s: String): Double; var aPos: Integer; begin - if '.' = DecimalSeparator then + if '.' = FormatSettings.DecimalSeparator then begin aPos := Pos(',', s) - else if ',' = DecimalSeparator then + end + else if ',' = FormatSettings.DecimalSeparator then begin aPos := Pos('.', s) + end else begin aPos := Pos(',', s); - if aPos = 0 then + if aPos = 0 then begin aPos := Pos('.', s); + end end; - if aPos <> 0 then - s[aPos] := TXmlChar(DecimalSeparator); + if aPos <> 0 then begin + s[aPos] := FormatSettings.DecimalSeparator; + end; Result := StrToFloat(s); end; -function FloatToXSTR(v: Double): TXmlString; +function FloatToXSTR(v: Double): String; var aPos: Integer; begin Result := FloatToStr(v); - aPos := Pos(DecimalSeparator, Result); - if aPos <> 0 then + aPos := Pos(FormatSettings.DecimalSeparator, Result); + if aPos <> 0 then begin Result[aPos] := '.'; + end; +end; + +function IsDigit(c: Char): Boolean; +begin + Result := (c >= '0') and (c <= '9') end; function XSTRToDateTime(const s: String): TDateTime; @@ -635,8 +630,9 @@ var i: Integer; begin i := aPos; - while (i <= Length(s)) and (s[i] in ['0'..'9']) do + while (i <= Length(s)) and IsDigit(s[i]) do begin Inc(i); + end; if i > aPos then Result := StrToInt(Copy(s, aPos, i - aPos)) else @@ -656,17 +652,17 @@ begin Result := EncodeDateTime(y, m, d, h, n, ss, 0); end; -function DateTimeToXSTR(v: TDateTime): TXmlString; +function DateTimeToXSTR(v: TDateTime): String; var y, m, d, h, n, s, ms: Word; begin DecodeDateTime(v, y, m, d, h, n, s, ms); - Result := Format('%.4d-%.2d-%.2dT%.2d-%.2d-%.2d', [y, m, d, h, n, s]) + Result := Format('%.4d-%.2d-%.2dT%.2d:%.2d:%.2d', [y, m, d, h, n, s]) end; -function VarToXSTR(const v: TVarData): TXmlString; +function VarToXSTR(const v: TVarData): String; const - BoolStr: array[Boolean] of TXmlString = ('0', '1'); + BoolStr: array[Boolean] of String = ('0', '1'); var p: Pointer; begin @@ -685,34 +681,22 @@ begin varWord: Result := IntToStr(v.VWord); varLongWord: Result := IntToStr(v.VLongWord); varInt64: Result := IntToStr(v.VInt64); - varString: Result := String(v.VString); - varArray + varByte: - begin - p := VarArrayLock(Variant(v)); - try - Result := BinToBase64(p^, VarArrayHighBound(Variant(v), 1) - VarArrayLowBound(Variant(v), 1) + 1, 0); - finally - VarArrayUnlock(Variant(v)) - end - end; - else + varString: Result := String(AnsiString(v.VString)); + varUString: Result := String(v.VString); + varArray + varByte: begin + p := VarArrayLock(Variant(v)); + try + Result := BinToBase64(p^, VarArrayHighBound(Variant(v), 1) - VarArrayLowBound(Variant(v), 1) + 1, 0); + finally + VarArrayUnlock(Variant(v)) + end + end; + else begin Result := Variant(v) + end end; end; -procedure PrepareToSaveXml(var anElem: IXmlElement; const aChildName: String); -begin - if aChildName <> '' then - anElem := anElem.AppendElement(aChildName); -end; - -function PrepareToLoadXml(var anElem: IXmlElement; const aChildName: String): Boolean; -begin - if (aChildName <> '') and Assigned(anElem) then - anElem := anElem.selectSingleNode(aChildName).AsElement; - Result := Assigned(anElem); -end; - function LoadXMLResource(aModule: HMODULE; aName, aType: PChar; const aXMLDoc: IXmlDocument): boolean; var aRSRC: HRSRC; @@ -744,24 +728,50 @@ begin end; end; -function IsXmlDataString(const aData: String): Boolean; + + + +function IsWhitespace(c: Char): Boolean; +begin + Result := c <= ' '; +end; + + + + +function IsAnsiWhitespace(c: AnsiChar): Boolean; +begin + Result := c <= ' '; +end; + + + + +function IsXmlDataString(const aData: RawByteString): Boolean; var i: Integer; begin Result := Copy(aData, 1, BinXmlSignatureSize) = BinXmlSignature; if not Result then begin i := 1; - while (i <= Length(aData)) and (aData[i] in [#10, #13, #9, ' ']) do + while (i <= Length(aData)) and IsAnsiWhitespace(aData[i]) do begin Inc(i); + end; Result := Copy(aData, i, Length(' 2 then begin o := po.a shl 16 or po.b shl 8 or po.c; - LongWord(pc^) := $3D3D3D3D; pc.a := Base64Map[(o shr 18) and $3F]; pc.b := Base64Map[(o shr 12) and $3F]; pc.c := Base64Map[(o shr 6) and $3F]; @@ -826,18 +836,24 @@ end; function CharTo6Bit(c: Char): Byte; begin - if (c >= 'A') and (c <= 'Z') then + if (c >= 'A') and (c <= 'Z') then begin Result := Ord(c) - Ord('A') - else if (c >= 'a') and (c <= 'z') then + end + else if (c >= 'a') and (c <= 'z') then begin Result := Ord(c) - Ord('a') + 26 - else if (c >= '0') and (c <= '9') then + end + else if (c >= '0') and (c <= '9') then begin Result := Ord(c) - Ord('0') + 52 - else if c = '+' then + end + else if c = '+' then begin Result := 62 - else if c = '/' then + end + else if c = '/' then begin Result := 63 - else + end + else begin Result := 0 + end end; procedure CharsToOctet(c: PChars; o: POctet); @@ -861,7 +877,7 @@ begin end; end; -function Base64ToBin(const aBase64: String): String; +function Base64ToBin(const aBase64: String): RawByteString; var o: POctet; c: PChars; @@ -872,27 +888,32 @@ begin s := aBase64; i := 1; while i <= Length(s) do begin - while (i <= Length(s)) and (s[i] > ' ') do + while (i <= Length(s)) and (s[i] > ' ') do begin Inc(i); + end; if i <= Length(s) then begin j := i; - while (j <= Length(s)) and (s[j] <= ' ') do + while (j <= Length(s)) and (s[j] <= ' ') do begin Inc(j); + end; Delete(s, i, j - i); end; end; - if Length(s) < 4 then - Result := '' + if Length(s) < 4 then begin + SetLength(Result, 0) + end else begin aCount := ((Length(s) + 3) div 4)*3; if aCount > 0 then begin - if s[Length(s) - 1] = '=' then + if s[Length(s) - 1] = '=' then begin Dec(aCount, 2) - else if s[Length(s)] = '=' then + end + else if s[Length(s)] = '=' then begin Dec(aCount); + end; SetLength(Result, aCount); - FillChar(Result[1], aCount, '*'); + FillChar(Result[1], aCount, 0); c := @s[1]; o := @Result[1]; while aCount > 0 do begin @@ -907,26 +928,26 @@ end; type - TBinXmlReader = class + TBinaryXmlReader = class private FOptions: LongWord; public procedure Read(var aBuf; aSize: Integer); virtual; abstract; - + function ReadLongint: Longint; - function ReadAnsiString: String; - function ReadWideString: WideString; - function ReadXmlString: TXmlString; + function ReadAnsiString: AnsiString; + function ReadUnicodeString: UnicodeString; + function ReadXmlString: String; procedure ReadVariant(var v: TVarData); end; - TStmXmlReader = class(TBinXmlReader) + TStreamBinaryXmlReader = class(TBinaryXmlReader) private FStream: TStream; FOptions: LongWord; FBufStart, FBufEnd, - FBufPtr: PChar; + FBufPtr: PByte; FBufSize, FRestSize: Integer; public @@ -936,37 +957,37 @@ type procedure Read(var aBuf; aSize: Integer); override; end; - TStrXmlReader = class(TBinXmlReader) + TRawByteStringBinaryXmlReader = class(TBinaryXmlReader) private - FString: String; + FString: RawByteString; FOptions: LongWord; - FPtr: PChar; + FPtr: PByte; FRestSize: Integer; public - constructor Create(const aStr: String); + constructor Create(const aStr: RawByteString); procedure Read(var aBuf; aSize: Integer); override; end; - TBinXmlWriter = class + TBinaryXmlWriter = class private FOptions: LongWord; public procedure Write(const aBuf; aSize: Integer); virtual; abstract; - + procedure WriteLongint(aValue: Longint); - procedure WriteAnsiString(const aValue: String); - procedure WriteWideString(const aValue: WideString); - procedure WriteXmlString(const aValue: TXmlString); + procedure WriteAnsiString(const aValue: AnsiString); + procedure WriteUnicodeString(const aValue: UnicodeString); + procedure WriteXmlString(const aValue: String); procedure WriteVariant(const v: TVarData); end; - TStmXmlWriter = class(TBinXmlWriter) + TStreamBinrayXmlWriter = class(TBinaryXmlWriter) private FStream: TStream; FBufStart, FBufEnd, - FBufPtr: PChar; + FBufPtr: PAnsiChar; FBufSize: Integer; public constructor Create(aStream: TStream; anOptions: LongWord; aBufSize: Integer); @@ -975,12 +996,12 @@ type procedure Write(const aBuf; aSize: Integer); override; end; - TStrXmlWriter = class(TBinXmlWriter) + TRawByteStringBinaryXmlWriter = class(TBinaryXmlWriter) private - FData: String; + FData: RawByteString; FBufStart, FBufEnd, - FBufPtr: PChar; + FBufPtr: PAnsiChar; FBufSize: Integer; procedure FlushBuf; public @@ -989,7 +1010,7 @@ type procedure Write(const aBuf; aSize: Integer); override; end; - + TXmlBase = class(TInterfacedObject, IXmlBase) protected // реализация интерфейса IXmlBase @@ -1001,7 +1022,7 @@ type TNameIndexArray = array of Longint; TXmlNameTable = class(TXmlBase, IXmlNameTable) private - FNames: array of TXmlString; + FNames: array of String; FHashTable: array of TNameIndexArray; FXmlTextNameID: Integer; @@ -1010,13 +1031,13 @@ type FXmlDocumentNameID: Integer; FXmlID: Integer; protected - function GetID(const aName: TXmlString): Integer; - function GetName(anID: Integer): TXmlString; + function GetID(const aName: String): Integer; + function GetName(anID: Integer): String; public constructor Create(aHashTableSize: Integer); - procedure LoadBinXml(aReader: TBinXmlReader); - procedure SaveBinXml(aWriter: TBinXmlWriter); + procedure LoadBinXml(aReader: TBinaryXmlReader); + procedure SaveBinXml(aWriter: TBinaryXmlWriter); end; { TXmlBase } @@ -1039,7 +1060,7 @@ begin FXmlID := GetID('xml'); end; -procedure TXmlNameTable.LoadBinXml(aReader: TBinXmlReader); +procedure TXmlNameTable.LoadBinXml(aReader: TBinaryXmlReader); var aCount: LongInt; anIndex, i: Integer; @@ -1047,13 +1068,15 @@ begin // Считать массив имен aCount := aReader.ReadLongint; SetLength(FNames, aCount); - for i := 0 to aCount - 1 do + for i := 0 to aCount - 1 do begin FNames[i] := aReader.ReadXmlString; + end; // Считать хэш-таблицу SetLength(FHashTable, aReader.ReadLongint); - for i := 0 to Length(FHashTable) - 1 do + for i := 0 to Length(FHashTable) - 1 do begin SetLength(FHashTable[i], 0); + end; aCount := aReader.ReadLongint; for i := 0 to aCount - 1 do begin anIndex := aReader.ReadLongInt; @@ -1062,7 +1085,7 @@ begin end; end; -procedure TXmlNameTable.SaveBinXml(aWriter: TBinXmlWriter); +procedure TXmlNameTable.SaveBinXml(aWriter: TBinaryXmlWriter); var aCount: LongInt; i: Integer; @@ -1070,15 +1093,18 @@ begin // Записать массив имен aCount := Length(FNames); aWriter.WriteLongint(aCount); - for i := 0 to aCount - 1 do + for i := 0 to aCount - 1 do begin aWriter.WriteXmlString(FNames[i]); + end; // Записать хэш-таблицу aWriter.WriteLongint(Length(FHashTable)); aCount := 0; - for i := 0 to Length(FHashTable) - 1 do - if Length(FHashTable[i]) > 0 then + for i := 0 to Length(FHashTable) - 1 do begin + if Length(FHashTable[i]) > 0 then begin Inc(aCount); + end + end; aWriter.WriteLongint(aCount); for i := 0 to Length(FHashTable) - 1 do begin aCount := Length(FHashTable[i]); @@ -1090,29 +1116,32 @@ begin end; end; -function TXmlNameTable.GetID(const aName: TXmlString): Integer; +function TXmlNameTable.GetID(const aName: String): Integer; - function NameHashKey(const aName: TXmlString): UINT; + function NameHashKey(const aName: String): UINT; var i: Integer; begin Result := 0; - for i := 1 to Length(aName) do + for i := 1 to Length(aName) do begin Result := UINT((int64(Result) shl 5) + Result + Ord(aName[i])); + end; end; var i: Integer; aNameIndexes: PNameIndexArray; begin - if aName = '' then + if aName = '' then begin Result := -1 + end else begin aNameIndexes := @FHashTable[NameHashKey(aName) mod UINT(Length(FHashTable))]; for i := 0 to Length(aNameIndexes^) - 1 do begin Result := aNameIndexes^[i]; - if FNames[Result] = aName then + if FNames[Result] = aName then begin Exit + end; end; Result := Length(FNames); SetLength(FNames, Result + 1); @@ -1123,12 +1152,14 @@ begin end; end; -function TXmlNameTable.GetName(anID: Integer): TXmlString; +function TXmlNameTable.GetName(anID: Integer): String; begin - if anID < 0 then + if anID < 0 then begin Result := '' - else + end + else begin Result := FNames[anID] + end end; function CreateNameTable(aHashTableSize: Integer): IXmlNameTable; @@ -1140,18 +1171,18 @@ type TXmlNode = class; TXmlToken = class private - FValueBuf: TXmlString; + FValueBuf: String; FValueStart, FValuePtr, - FValueEnd: PXmlChar; + FValueEnd: PChar; public constructor Create; procedure Clear; - procedure AppendChar(aChar: TXmlChar); - procedure AppendText(aText: PXmlChar; aCount: Integer); + procedure AppendChar(aChar: Char); + procedure AppendText(aText: PChar; aCount: Integer); function Length: Integer; - property ValueStart: PXmlChar read FValueStart; + property ValueStart: PChar read FValueStart; end; TXmlSource = class @@ -1161,9 +1192,9 @@ type FTokenStack: array of TXmlToken; FTokenStackTop: Integer; FToken: TXmlToken; - function ExpectQuotedText(aQuote: TXmlChar): TXmlString; + function ExpectQuotedText(aQuote: Char): String; public - CurChar: TXmlChar; + CurChar: Char; constructor Create; destructor Destroy; override; @@ -1172,39 +1203,40 @@ type function Next: Boolean; procedure SkipBlanks; - function ExpectXmlName: TXmlString; - function ExpectXmlEntity: TXmlChar; - procedure ExpectChar(aChar: TXmlChar); - procedure ExpectText(aText: PXmlChar); + function ExpectXmlName: String; + function ExpectXmlEntity: Char; + procedure ExpectChar(aChar: Char); + procedure ExpectText(aText: PChar); function ExpectDecimalInteger: Integer; function ExpectHexInteger: Integer; - function ParseTo(aText: PXmlChar): TXmlString; + function ParseTo(aText: PChar): String; procedure ParseAttrs(aNode: TXmlNode); procedure NewToken; - procedure AppendTokenChar(aChar: TXmlChar); - procedure AppendTokenText(aText: PXmlChar; aCount: Integer); - function AcceptToken: TXmlString; + procedure AppendTokenChar(aChar: Char); + procedure AppendTokenText(aText: PChar; aCount: Integer); + function AcceptToken: String; procedure DropToken; end; - TXmlStrSource = class(TXmlSource) + TStringXmlSource = class(TXmlSource) private - FSource: TXmlString; + FSource: String; FSourcePtr, - FSourceEnd: PXmlChar; + FSourceEnd: PChar; public - constructor Create(const aSource: TXmlString); + constructor Create(const aSource: String); function EOF: Boolean; override; function DoNext: Boolean; override; end; - TXmlStmSource = class(TXmlSource) + TAnsiStreamXmlSource = class(TXmlSource) private FStream: TStream; FBufStart, FBufPtr, - FBufEnd: PChar; + FBufEnd: PAnsiChar; + FBufSize: Integer; FSize: Integer; public @@ -1224,7 +1256,7 @@ type protected function Get_Count: Integer; function Get_Item(anIndex: Integer): IXmlNode; - function Get_XML: TXmlString; + function Get_XML: String; procedure GetXML(var anXml: TStringBuilder); public constructor Create(anOwnerNode: TXmlNode); @@ -1234,8 +1266,8 @@ type procedure ParseXML(anXml: TXmlSource; aNames: TXmlNameTable; aPreserveWhiteSpace: Boolean); procedure SortElements(aCompare: TXmlCompareNodes); - procedure LoadBinXml(aReader: TBinXmlReader; aCount: Integer; aNames: TXmlNameTable); - procedure SaveBinXml(aWriter: TBinXmlWriter); + procedure LoadBinXml(aReader: TBinaryXmlReader; aCount: Integer; aNames: TXmlNameTable); + procedure SaveBinXml(aWriter: TBinaryXmlWriter); procedure InsertNode(aNode: TXmlNode; anIndex: Integer); function RemoveNode(aNode: TXmlNode): Integer; @@ -1287,134 +1319,137 @@ type function Get_SourceCol: Integer; function Get_NameTable: IXmlNameTable; - function Get_NodeName: TXmlString; + function Get_NodeName: String; function Get_NodeNameID: Integer; virtual; abstract; function Get_NodeType: Integer; virtual; abstract; - function Get_Text: TXmlString; virtual; abstract; - procedure Set_Text(const aValue: TXmlString); virtual; abstract; + function Get_Text: String; virtual; abstract; + procedure Set_Text(const aValue: String); virtual; abstract; function CloneNode(aDeep: Boolean): IXmlNode; - procedure LoadBinXml(aReader: TBinXmlReader); - procedure SaveBinXml(aWriter: TBinXmlWriter); + procedure LoadBinXml(aReader: TBinaryXmlReader); + procedure SaveBinXml(aWriter: TBinaryXmlWriter); function Get_DataType: Integer; virtual; function Get_TypedValue: Variant; virtual; procedure Set_TypedValue(const aValue: Variant); virtual; - procedure GetXML(var anXml: TStringBuilder); virtual; abstract; - function Get_XML: TXmlString; virtual; + procedure GetXML(var anXml: TStringBuilder); virtual; abstract; + function Get_XML: String; virtual; function Get_OwnerDocument: IXmlDocument; virtual; function Get_ParentNode: IXmlNode; - function Get_NextSibling: IXmlNode; + function Get_NextSibling: IXmlNode; function Get_ChildNodes: IXmlNodeList; virtual; procedure AppendChild(const aChild: IXmlNode); function AppendElement(aNameID: Integer): IXmlElement; overload; - function AppendElement(const aName: TxmlString): IXmlElement; overload; - function AppendText(const aData: TXmlString): IXmlText; - function AppendCDATA(const aData: TXmlString): IXmlCDATASection; - function AppendComment(const aData: TXmlString): IXmlComment; + function AppendElement(const aName: String): IXmlElement; overload; + function AppendText(const aData: String): IXmlText; + function AppendCDATA(const aData: String): IXmlCDATASection; + function AppendComment(const aData: String): IXmlComment; function AppendProcessingInstruction(aTargetID: Integer; - const aData: TXmlString): IXmlProcessingInstruction; overload; - function AppendProcessingInstruction(const aTarget: TXmlString; - const aData: TXmlString): IXmlProcessingInstruction; overload; + const aData: String): IXmlProcessingInstruction; overload; + function AppendProcessingInstruction(const aTarget: String; + const aData: String): IXmlProcessingInstruction; overload; procedure InsertBefore(const aChild, aBefore: IXmlNode); procedure ReplaceChild(const aNewChild, anOldChild: IXmlNode); procedure RemoveChild(const aChild: IXmlNode); - function GetChildText(const aName: TXmlString; const aDefault: TXmlString = ''): TXmlString; overload; - function GetChildText(aNameID: Integer; const aDefault: TXmlString = ''): TXmlString; overload; - procedure SetChildText(const aName, aValue: TXmlString); overload; - procedure SetChildText(aNameID: Integer; const aValue: TXmlString); overload; + function GetChildText(const aName: String; const aDefault: String = ''): String; overload; + function GetChildText(aNameID: Integer; const aDefault: String = ''): String; overload; + procedure SetChildText(const aName, aValue: String); overload; + procedure SetChildText(aNameID: Integer; const aValue: String); overload; function NeedChild(aNameID: Integer): IXmlNode; overload; - function NeedChild(const aName: TXmlString): IXmlNode; overload; + function NeedChild(const aName: String): IXmlNode; overload; function EnsureChild(aNameID: Integer): IXmlNode; overload; - function EnsureChild(const aName: TXmlString): IXmlNode; overload; + function EnsureChild(const aName: String): IXmlNode; overload; procedure RemoveAllChilds; - function SelectNodes(const anExpression: TXmlString): IXmlNodeList; overload; + function SelectNodes(const anExpression: String): IXmlNodeList; overload; function SelectNodes(aNodeNameID: Integer): IXmlNodeList; overload; - function SelectSingleNode(const anExpression: TXmlString): IXmlNode; + function SelectSingleNode(const anExpression: String): IXmlNode; function FindElement(const anElementName, anAttrName: String; const anAttrValue: Variant): IXmlElement; function FindElements(const anElementName, anAttrName: String; const anAttrValue: Variant): IXmlNodeList; function Get_AttrCount: Integer; function Get_AttrNameID(anIndex: Integer): Integer; - function Get_AttrName(anIndex: Integer): TXmlString; - procedure RemoveAttr(const aName: TXmlString); overload; + function Get_AttrName(anIndex: Integer): String; + procedure RemoveAttr(const aName: String); overload; procedure RemoveAttr(aNameID: Integer); overload; procedure RemoveAllAttrs; function AttrExists(aNameID: Integer): Boolean; overload; - function AttrExists(const aName: TXmlString): Boolean; overload; + function AttrExists(const aName: String): Boolean; overload; function GetAttrType(aNameID: Integer): Integer; overload; - function GetAttrType(const aName: TXmlString): Integer; overload; + function GetAttrType(const aName: String): Integer; overload; function GetVarAttr(aNameID: Integer; const aDefault: Variant): Variant; overload; - function GetVarAttr(const aName: TXmlString; const aDefault: Variant): Variant; overload; + function GetVarAttr(const aName: String; const aDefault: Variant): Variant; overload; procedure SetVarAttr(aNameID: Integer; const aValue: Variant); overload; - procedure SetVarAttr(const aName: TXmlString; aValue: Variant); overload; + procedure SetVarAttr(const aName: String; aValue: Variant); overload; function NeedVarAttr(aNameID: Integer): Variant; overload; - function NeedVarAttr(const aName: TXmlString): Variant; overload; + function NeedVarAttr(const aName: String): Variant; overload; - function NeedAttr(aNameID: Integer): TXmlString; overload; - function NeedAttr(const aName: TXmlString): TXmlString; overload; + function NeedAttr(aNameID: Integer): String; overload; + function NeedAttr(const aName: String): String; overload; - function GetAttr(aNameID: Integer; const aDefault: TXmlString = ''): TXmlString; overload; - function GetAttr(const aName: TXmlString; const aDefault: TXmlString = ''): TXmlString; overload; - procedure SetAttr(aNameID: Integer; const aValue: TXmlString); overload; - procedure SetAttr(const aName, aValue: TXmlString); overload; + function GetAttr(aNameID: Integer; const aDefault: String = ''): String; overload; + function GetAttr(const aName: String; const aDefault: String = ''): String; overload; + procedure SetAttr(aNameID: Integer; const aValue: String); overload; + procedure SetAttr(const aName, aValue: String); overload; function GetBoolAttr(aNameID: Integer; aDefault: Boolean = False): Boolean; overload; - function GetBoolAttr(const aName: TXmlString; aDefault: Boolean = False): Boolean; overload; + function GetBoolAttr(const aName: String; aDefault: Boolean = False): Boolean; overload; procedure SetBoolAttr(aNameID: Integer; aValue: Boolean = False); overload; - procedure SetBoolAttr(const aName: TXmlString; aValue: Boolean); overload; + procedure SetBoolAttr(const aName: String; aValue: Boolean); overload; function GetIntAttr(aNameID: Integer; aDefault: Integer = 0): Integer; overload; - function GetIntAttr(const aName: TXmlString; aDefault: Integer = 0): Integer; overload; + function GetIntAttr(const aName: String; aDefault: Integer = 0): Integer; overload; + function NeedIntAttr(const aName: String): Integer; overload; + function NeedIntAttr(aNameID: Integer): Integer; overload; + procedure SetIntAttr(aNameID: Integer; aValue: Integer); overload; - procedure SetIntAttr(const aName: TXmlString; aValue: Integer); overload; + procedure SetIntAttr(const aName: String; aValue: Integer); overload; function GetDateTimeAttr(aNameID: Integer; aDefault: TDateTime = 0): TDateTime; overload; - function GetDateTimeAttr(const aName: TXmlString; aDefault: TDateTime = 0): TDateTime; overload; + function GetDateTimeAttr(const aName: String; aDefault: TDateTime = 0): TDateTime; overload; procedure SetDateTimeAttr(aNameID: Integer; aValue: TDateTime); overload; - procedure SetDateTimeAttr(const aName: TXmlString; aValue: TDateTime); overload; + procedure SetDateTimeAttr(const aName: String; aValue: TDateTime); overload; function GetFloatAttr(aNameID: Integer; aDefault: Double = 0): Double; overload; - function GetFloatAttr(const aName: TXmlString; aDefault: Double = 0): Double; overload; + function GetFloatAttr(const aName: String; aDefault: Double = 0): Double; overload; function NeedFloatAttr(aNameID: Integer): Double; overload; - function NeedFloatAttr(const aName: TXmlString): Double; overload; + function NeedFloatAttr(const aName: String): Double; overload; procedure SetFloatAttr(aNameID: Integer; aValue: Double); overload; - procedure SetFloatAttr(const aName: TXmlString; aValue: Double); overload; + procedure SetFloatAttr(const aName: String; aValue: Double); overload; - function GetHexAttr(const aName: TXmlString; aDefault: Integer = 0): Integer; overload; + function GetHexAttr(const aName: String; aDefault: Integer = 0): Integer; overload; function GetHexAttr(aNameID: Integer; aDefault: Integer = 0): Integer; overload; - procedure SetHexAttr(const aName: TXmlString; aValue: Integer; aDigits: Integer = 8); overload; + procedure SetHexAttr(const aName: String; aValue: Integer; aDigits: Integer = 8); overload; procedure SetHexAttr(aNameID: Integer; aValue: Integer; aDigits: Integer = 8); overload; - function GetEnumAttr(const aName: TXmlString; - const aValues: array of TXmlString; aDefault: Integer = 0): Integer; overload; + function GetEnumAttr(const aName: String; + const aValues: array of String; aDefault: Integer = 0): Integer; overload; function GetEnumAttr(aNameID: Integer; - const aValues: array of TXmlString; aDefault: Integer = 0): Integer; overload; - function NeedEnumAttr(const aName: TXmlString; - const aValues: array of TXmlString): Integer; overload; + const aValues: array of String; aDefault: Integer = 0): Integer; overload; + function NeedEnumAttr(const aName: String; + const aValues: array of String): Integer; overload; function NeedEnumAttr(aNameID: Integer; - const aValues: array of TXmlString): Integer; overload; + const aValues: array of String): Integer; overload; - procedure RemoveTextNodes; - procedure ReplaceTextByCDATASection(const aText: TXmlString); - procedure ReplaceTextByBynaryData(const aData; aSize: Integer; + procedure RemoveTextNodes; + procedure ReplaceTextByCDATASection(const aText: String); + procedure ReplaceTextByBinaryData(const aData; aSize: Integer; aMaxLineLength: Integer); - function GetTextAsBynaryData: String; - function GetOwnText: TXmlString; + function GetTextAsBinaryData: RawByteString; + function GetOwnText: String; function Get_Values(const aName: String): Variant; procedure Set_Values(const aName: String; const aValue: Variant); @@ -1441,8 +1476,8 @@ type function Get_NodeNameID: Integer; override; function Get_NodeType: Integer; override; - function Get_Text: TXmlString; override; - procedure Set_Text(const aValue: TXmlString); override; + function Get_Text: String; override; + procedure Set_Text(const aValue: String); override; function Get_DataType: Integer; override; function Get_TypedValue: Variant; override; procedure Set_TypedValue(const aValue: Variant); override; @@ -1456,12 +1491,12 @@ type TXmlCharacterData = class(TXmlNode, IXmlCharacterData) private - FData: TXmlString; + FData: String; protected - function Get_Text: TXmlString; override; - procedure Set_Text(const aValue: TXmlString); override; + function Get_Text: String; override; + procedure Set_Text(const aValue: String); override; public - constructor Create(aNames: TXmlNameTable; const aData: TXmlString); + constructor Create(aNames: TXmlNameTable; const aData: String); end; TXmlText = class(TXmlNode, IXmlText) @@ -1471,8 +1506,8 @@ type protected function Get_NodeNameID: Integer; override; function Get_NodeType: Integer; override; - function Get_Text: TXmlString; override; - procedure Set_Text(const aValue: TXmlString); override; + function Get_Text: String; override; + procedure Set_Text(const aValue: String); override; function Get_DataType: Integer; override; function Get_TypedValue: Variant; override; procedure Set_TypedValue(const aValue: Variant); override; @@ -1511,14 +1546,15 @@ type protected function Get_NodeNameID: Integer; override; function Get_NodeType: Integer; override; - function Get_Text: TXmlString; override; - procedure Set_Text(const aText: TXmlString); override; - procedure GetXML(var anXml: TStringBuilder); override; + function Get_Text: String; override; + procedure Set_Text(const aText: String); override; + procedure GetXML(var anXml: TStringBuilder); override; function AsProcessingInstruction: IXmlProcessingInstruction; override; + function Get_Target: String; public constructor Create(aNames: TXmlNameTable; aTargetID: Integer; - const aData: TXmlString); + const aData: String); end; TXmlDocument = class(TXmlNode, IXmlDocument) @@ -1529,42 +1565,43 @@ type protected function Get_NodeNameID: Integer; override; function Get_NodeType: Integer; override; - function Get_Text: TXmlString; override; - procedure Set_Text(const aText: TXmlString); override; + function Get_Text: String; override; + procedure Set_Text(const aText: String); override; procedure GetXML(var anXml: TStringBuilder); override; function Get_PreserveWhiteSpace: Boolean; procedure Set_PreserveWhiteSpace(aValue: Boolean); - function NewDocument(const aVersion, anEncoding: TXmlString; + function NewDocument(const aVersion, anEncoding: String; aRootElementNameID: Integer): IXmlElement; overload; function NewDocument(const aVersion, anEncoding, - aRootElementName: TXmlString): IXmlElement; overload; + aRootElementName: String): IXmlElement; overload; function CreateElement(aNameID: Integer): IXmlElement; overload; - function CreateElement(const aName: TXmlString): IXmlElement; overload; - function CreateText(const aData: TXmlString): IXmlText; - function CreateCDATASection(const aData: TXmlString): IXmlCDATASection; - function CreateComment(const aData: TXmlString): IXmlComment; + function CreateElement(const aName: String): IXmlElement; overload; + function CreateText(const aData: String): IXmlText; + function CreateCDATASection(const aData: String): IXmlCDATASection; + function CreateComment(const aData: String): IXmlComment; function Get_DocumentElement: IXmlElement; function CreateProcessingInstruction(const aTarget, - aData: TXmlString): IXmlProcessingInstruction; overload; + aData: String): IXmlProcessingInstruction; overload; function CreateProcessingInstruction(aTargetID: Integer; - const aData: TXmlString): IXmlProcessingInstruction; overload; - procedure LoadXML(const anXml: TXmlString); + const aData: String): IXmlProcessingInstruction; overload; + procedure LoadXML(const anXml: String); overload; + procedure LoadXML(const anXml: RawByteString); overload; procedure Load(aStream: TStream); overload; - procedure Load(const aFileName: TXmlString); overload; + procedure Load(const aFileName: String); overload; procedure LoadResource(aType, aName: PChar); procedure Save(aStream: TStream); overload; - procedure Save(const aFileName: TXmlString); overload; + procedure Save(const aFileName: String); overload; procedure SaveBinary(aStream: TStream; anOptions: LongWord); overload; - procedure SaveBinary(const aFileName: TXmlString; anOptions: LongWord); overload; + procedure SaveBinary(const aFileName: String; anOptions: LongWord); overload; - function Get_BinaryXML: String; - procedure LoadBinaryXML(const anXml: String); + function Get_BinaryXML: RawByteString; + procedure LoadBinaryXML(const anXml: RawByteString); public constructor Create(aNames: TXmlNameTable); end; @@ -1578,8 +1615,9 @@ var begin for i := 0 to FCount - 1 do begin aNode := FItems[i]; - if Assigned(FOwnerNode) then + if Assigned(FOwnerNode) then begin aNode.FParentNode := nil; + end; aNode._Release; end; FCount := 0; @@ -1591,12 +1629,13 @@ var begin aNode := FItems[anIndex]; Dec(FCount); - if anIndex < FCount then - Move(FItems[anIndex + 1], FItems[anIndex], - (FCount - anIndex)*SizeOf(TXmlNode)); + if anIndex < FCount then begin + Move(FItems[anIndex + 1], FItems[anIndex], (FCount - anIndex)*SizeOf(TXmlNode)); + end; if Assigned(aNode) then begin - if Assigned(FOwnerNode) then + if Assigned(FOwnerNode) then begin aNode.FParentNode := nil; + end; aNode._Release; end; end; @@ -1615,8 +1654,9 @@ end; function TXmlNodeList.Get_Item(anIndex: Integer): IXmlNode; begin - if (anIndex < 0) or (anIndex >= FCount) then + if (anIndex < 0) or (anIndex >= FCount) then begin raise Exception.Create(SSimpleXmlError1); + end; Result := FItems[anIndex] end; @@ -1629,11 +1669,12 @@ function TXmlNodeList.IndexOfNode(aNode: TXmlNode): Integer; var i: Integer; begin - for i := 0 to FCount - 1 do + for i := 0 to FCount - 1 do begin if FItems[i] = aNode then begin Result := i; Exit end; + end; Result := -1; end; @@ -1641,25 +1682,31 @@ procedure TXmlNodeList.Grow; var aDelta: Integer; begin - if Length(FItems) > 64 then + if Length(FItems) > 64 then begin aDelta := Length(FItems) div 4 - else - if Length(FItems) > 8 then + end + else begin + if Length(FItems) > 8 then begin aDelta := 16 - else + end + else begin aDelta := 4; + end + end; SetLength(FItems, Length(FItems) + aDelta); end; procedure TXmlNodeList.InsertNode(aNode: TXmlNode; anIndex: Integer); begin - if anIndex = -1 then + if anIndex = -1 then begin anIndex := FCount; - if FCount = Length(FItems) then + end; + if FCount = Length(FItems) then begin Grow; - if anIndex < FCount then - Move(FItems[anIndex], FItems[anIndex + 1], - (FCount - anIndex)*SizeOf(TXmlNode)); + end; + if anIndex < FCount then begin + Move(FItems[anIndex], FItems[anIndex + 1], (FCount - anIndex)*SizeOf(TXmlNode)); + end; FItems[anIndex] := aNode; Inc(FCount); if aNode <> nil then begin @@ -1674,8 +1721,9 @@ end; function TXmlNodeList.RemoveNode(aNode: TXmlNode): Integer; begin Result := IndexOfNode(aNode); - if Result <> -1 then + if Result <> -1 then begin DeleteNode(Result); + end; end; procedure TXmlNodeList.ReplaceNode(anIndex: Integer; aNode: TXmlNode); @@ -1683,24 +1731,26 @@ var anOldNode: TXmlNode; begin anOldNode := FItems[anIndex]; - if aNode <> anOldNode then begin - if Assigned(anOldNode) then begin - if Assigned(FOwnerNode) then - anOldNode.FParentNode := nil; - anOldNode._Release; - end; - FItems[anIndex] := aNode; - if Assigned(aNode) then begin - aNode._AddRef; - if Assigned(FOwnerNode) then begin - aNode.FParentNode := FOwnerNode; - aNode.SetNameTable(FOwnerNode.FNames, nil); - end - end - end; + if aNode = anOldNode then begin + exit + end; + if Assigned(anOldNode) then begin + if Assigned(FOwnerNode) then begin + anOldNode.FParentNode := nil; + end; + anOldNode._Release; + end; + FItems[anIndex] := aNode; + if Assigned(aNode) then begin + aNode._AddRef; + if Assigned(FOwnerNode) then begin + aNode.FParentNode := FOwnerNode; + aNode.SetNameTable(FOwnerNode.FNames, nil); + end + end end; -function TXmlNodeList.Get_XML: TXmlString; +function TXmlNodeList.Get_XML: String; var anXml: TStringBuilder; begin @@ -1713,8 +1763,9 @@ procedure TXmlNodeList.GetXML(var anXml: TStringBuilder); var i: Integer; begin - for i := 0 to FCount - 1 do + for i := 0 to FCount - 1 do begin FItems[i].GetXML(anXml); + end; end; procedure TXmlNodeList.ParseXML(anXml: TXmlSource; aNames: TXmlNameTable; aPreserveWhiteSpace: Boolean); @@ -1735,22 +1786,25 @@ var aText: String; begin anXml.NewToken; - while not anXml.EOF and (anXml.CurChar <> '<') do - if anXml.CurChar = '&' then + while not anXml.EOF and (anXml.CurChar <> '<') do begin + if anXml.CurChar = '&' then begin anXml.AppendTokenChar(anXml.ExpectXmlEntity) + end else begin anXml.AppendTokenChar(anXml.CurChar); anXml.Next; end; + end; aText := anXml.AcceptToken; - if aPreserveWhiteSpace or (Trim(aText) <> '') then + if aPreserveWhiteSpace or (Trim(aText) <> '') then begin DoAppend(TXmlText.Create(aNames, aText)); + end; end; // CurChar - '?' procedure ParseProcessingInstruction; var - aTarget: TXmlString; + aTarget: String; aNode: TXmlProcessingInstruction; begin anXml.Next; @@ -1761,8 +1815,9 @@ var anXml.ParseAttrs(aNode); anXml.ExpectText('?>'); end - else + else begin aNode.FData := anXml.ParseTo('?>'); + end end; // на входе: первый '--' @@ -1798,20 +1853,23 @@ var aNode: TXmlElement; begin aNameID := aNames.GetID(anXml.ExpectXmlName); - if anXml.EOF then + if anXml.EOF then begin raise Exception.Create(SSimpleXMLError2); - if not ((anXml.CurChar <= ' ') or (anXml.CurChar = '/') or (anXml.CurChar = '>')) then + end; + if not ((anXml.CurChar <= ' ') or (anXml.CurChar = '/') or (anXml.CurChar = '>')) then begin raise Exception.Create(SSimpleXMLError3); + end; aNode := TXmlElement.Create(aNames, aNameID); DoAppend(aNode); anXml.ParseAttrs(aNode); - if anXml.CurChar = '/' then + if anXml.CurChar = '/' then begin anXml.ExpectText('/>') + end else begin anXml.ExpectChar('>'); aNode.GetChilds.ParseXML(anXml, aNames, aPreserveWhiteSpace); anXml.ExpectChar('/'); - anXml.ExpectText(PXmlChar(aNames.GetName(aNameID))); + anXml.ExpectText(PChar(aNames.GetName(aNameID))); anXml.SkipBlanks; anXml.ExpectChar('>'); end; @@ -1824,27 +1882,36 @@ begin ParseText; aLine := anXml.FCurLine; aCol := anXml.FCurPos; - if anXml.CurChar = '<' then // символ разметки - if anXml.Next then - if anXml.CurChar = '/' then // закрывающий тэг элемента + if anXml.CurChar = '<' then begin // символ разметки + if anXml.Next then begin + if anXml.CurChar = '/' then begin // закрывающий тэг элемента Exit - else if anXml.CurChar = '?' then // инструкция + end + else if anXml.CurChar = '?' then begin // инструкция ParseProcessingInstruction + end else if anXml.CurChar = '!' then begin - if anXml.Next then - if anXml.CurChar = '-' then // коментарий + if anXml.Next then begin + if anXml.CurChar = '-' then begin // коментарий ParseComment - else if anXml.CurChar = '[' then // секция CDATA + end + else if anXml.CurChar = '[' then begin // секция CDATA ParseCDATA - else + end + else begin ParseDOCTYPE + end + end end - else // открывающий тэг элемента + else begin // открывающий тэг элемента ParseElement + end + end + end end; end; -procedure TXmlNodeList.LoadBinXml(aReader: TBinXmlReader; +procedure TXmlNodeList.LoadBinXml(aReader: TBinaryXmlReader; aCount: Integer; aNames: TXmlNameTable); var i: Integer; @@ -1857,39 +1924,39 @@ begin for i := 0 to aCount - 1 do begin aReader.Read(aNodeType, sizeof(aNodeType)); case aNodeType of - NODE_ELEMENT: - begin - aNameID := aReader.ReadLongint; - aNode := TXmlElement.Create(aNames, aNameID); - InsertNode(aNode, -1); - aReader.ReadVariant(TVarData(TXmlElement(aNode).FData)); - aNode.LoadBinXml(aReader); - end; - NODE_TEXT: - begin - aNode := TXmlText.Create(aNames, Unassigned); - InsertNode(aNode, -1); - aReader.ReadVariant(TVarData(TXmlText(aNode).FData)); - end; - NODE_CDATA_SECTION: + NODE_ELEMENT: begin + aNameID := aReader.ReadLongint; + aNode := TXmlElement.Create(aNames, aNameID); + InsertNode(aNode, -1); + aReader.ReadVariant(TVarData(TXmlElement(aNode).FData)); + aNode.LoadBinXml(aReader); + end; + NODE_TEXT: begin + aNode := TXmlText.Create(aNames, Unassigned); + InsertNode(aNode, -1); + aReader.ReadVariant(TVarData(TXmlText(aNode).FData)); + end; + NODE_CDATA_SECTION: begin InsertNode(TXmlCDATASection.Create(aNames, aReader.ReadXmlString), -1); - NODE_PROCESSING_INSTRUCTION: - begin - aNameID := aReader.ReadLongint; - aNode := TXmlProcessingInstruction.Create(aNames, aNameID, - aReader.ReadXmlString); - InsertNode(aNode, -1); - aNode.LoadBinXml(aReader); - end; - NODE_COMMENT: + end; + NODE_PROCESSING_INSTRUCTION: begin + aNameID := aReader.ReadLongint; + aNode := TXmlProcessingInstruction.Create(aNames, aNameID, + aReader.ReadXmlString); + InsertNode(aNode, -1); + aNode.LoadBinXml(aReader); + end; + NODE_COMMENT: begin InsertNode(TXmlComment.Create(aNames, aReader.ReadXmlString), -1); - else + end + else begin raise Exception.Create(SSimpleXMLError4); + end end end; end; -procedure TXmlNodeList.SaveBinXml(aWriter: TBinXmlWriter); +procedure TXmlNodeList.SaveBinXml(aWriter: TBinaryXmlWriter); const EmptyVar: TVarData = (VType:varEmpty); var @@ -2033,7 +2100,7 @@ begin Result := FAttrCount; end; -function TXmlNode.Get_AttrName(anIndex: Integer): TXmlString; +function TXmlNode.Get_AttrName(anIndex: Integer): String; begin Result := FNames.GetName(FAttrs[anIndex].NameID); end; @@ -2053,25 +2120,27 @@ begin Result := FNames end; -function TXmlNode.GetAttr(const aName, aDefault: TXmlString): TXmlString; +function TXmlNode.GetAttr(const aName, aDefault: String): String; begin Result := GetAttr(FNames.GetID(aName), aDefault) end; function TXmlNode.GetAttr(aNameID: Integer; - const aDefault: TXmlString): TXmlString; + const aDefault: String): String; var aData: PXmlAttrData; begin aData := FindAttrData(aNameID); - if Assigned(aData) then + if Assigned(aData) then begin Result := aData.Value - else + end + else begin Result := aDefault + end end; function TXmlNode.GetBoolAttr(aNameID: Integer; - aDefault: Boolean): Boolean; + aDefault: Boolean): Boolean; var aData: PXmlAttrData; begin @@ -2082,7 +2151,7 @@ begin Result := aDefault end; -function TXmlNode.GetBoolAttr(const aName: TXmlString; +function TXmlNode.GetBoolAttr(const aName: String; aDefault: Boolean): Boolean; begin Result := GetBoolAttr(FNames.GetID(aName), aDefault) @@ -2102,7 +2171,7 @@ begin end; function TXmlNode.GetChildText(aNameID: Integer; - const aDefault: TXmlString): TXmlString; + const aDefault: String): String; var aChild: TXmlNode; begin @@ -2113,42 +2182,43 @@ begin Result := aDefault end; -function TXmlNode.GetChildText(const aName: TXmlString; - const aDefault: TXmlString): TXmlString; +function TXmlNode.GetChildText(const aName: String; + const aDefault: String): String; begin Result := GetChildText(FNames.GetID(aName), aDefault); end; -function TXmlNode.GetEnumAttr(const aName: TXmlString; - const aValues: array of TXmlString; aDefault: Integer): Integer; +function TXmlNode.GetEnumAttr(const aName: String; + const aValues: array of String; aDefault: Integer): Integer; begin Result := GetEnumAttr(FNames.GetID(aName), aValues, aDefault); end; function EnumAttrValue(aNode: TXmlNode; anAttrData: PXmlAttrData; - const aValues: array of TXmlString): Integer; + const aValues: array of String): Integer; var - anAttrValue: TXmlString; + anAttrValue: String; s: String; i: Integer; begin anAttrValue := anAttrData.Value; for Result := 0 to Length(aValues) - 1 do - if AnsiCompareText(anAttrValue, aValues[Result]) = 0 then + if CompareText(anAttrValue, aValues[Result]) = 0 then Exit; if Length(aValues) = 0 then s := '' else begin s := aValues[0]; - for i := 1 to Length(aValues) - 1 do - s := s + ^M^J + aValues[i]; + for i := 1 to Length(aValues) - 1 do begin + s := s + ^M+^J + aValues[i]; + end end; raise Exception.CreateFmt(SSimpleXmlError6, [aNode.FNames.GetName(anAttrData.NameID), aNode.Get_NodeName, s]); end; function TXmlNode.GetEnumAttr(aNameID: Integer; - const aValues: array of TXmlString; aDefault: Integer): Integer; + const aValues: array of String; aDefault: Integer): Integer; var anAttrData: PXmlAttrData; begin @@ -2159,14 +2229,14 @@ begin Result := aDefault; end; -function TXmlNode.NeedEnumAttr(const aName: TXmlString; - const aValues: array of TXmlString): Integer; +function TXmlNode.NeedEnumAttr(const aName: String; + const aValues: array of String): Integer; begin Result := NeedEnumAttr(FNames.GetID(aName), aValues) end; function TXmlNode.NeedEnumAttr(aNameID: Integer; - const aValues: array of TXmlString): Integer; + const aValues: array of String): Integer; var anAttrData: PXmlAttrData; begin @@ -2177,7 +2247,7 @@ begin raise Exception.CreateFmt(SSimpleXMLError7, [FNames.GetName(aNameID)]); end; -function TXmlNode.GetFloatAttr(const aName: TXmlString; +function TXmlNode.GetFloatAttr(const aName: String; aDefault: Double): Double; begin Result := GetFloatAttr(FNames.GetID(aName), aDefault); @@ -2212,11 +2282,30 @@ begin Result := XSTRToFloat(aData.Value) end; -function TXmlNode.NeedFloatAttr(const aName: TXmlString): Double; +function TXmlNode.NeedFloatAttr(const aName: String): Double; begin Result := NeedFloatAttr(FNames.GetID(aName)); end; +function TXmlNode.NeedIntAttr(const aName: String): Integer; +begin + Result := NeedIntAttr(FNames.GetID(aName)) +end; + +function TXmlNode.NeedIntAttr(aNameID: Integer): Integer; +var + aData: PXmlAttrData; +begin + aData := FindAttrData(aNameID); + if not Assigned(aData) then + raise Exception.CreateFmt(SSimpleXmlError8, [FNames.GetName(aNameID)]); + + if VarIsOrdinal(aData.Value) then + Result := aData.Value + else + Result := StrToInt(aData.Value) +end; + function TXmlNode.GetHexAttr(aNameID, aDefault: Integer): Integer; var anAttr: PXmlAttrData; @@ -2228,7 +2317,7 @@ begin Result := aDefault; end; -function TXmlNode.GetHexAttr(const aName: TXmlString; +function TXmlNode.GetHexAttr(const aName: String; aDefault: Integer): Integer; begin Result := GetHexAttr(FNames.GetID(aName), aDefault) @@ -2245,7 +2334,7 @@ begin Result := aDefault; end; -function TXmlNode.GetIntAttr(const aName: TXmlString; +function TXmlNode.GetIntAttr(const aName: String; aDefault: Integer): Integer; begin Result := GetIntAttr(FNames.GetID(aName), aDefault) @@ -2261,12 +2350,12 @@ begin Result := anAttr.Value end; -function TXmlNode.NeedVarAttr(const aName: TXmlString): Variant; +function TXmlNode.NeedVarAttr(const aName: String): Variant; begin Result := NeedAttr(FNames.GetID(aName)) end; -function TXmlNode.NeedAttr(aNameID: Integer): TXmlString; +function TXmlNode.NeedAttr(aNameID: Integer): String; var anAttr: PXmlAttrData; begin @@ -2276,7 +2365,7 @@ begin Result := anAttr.Value end; -function TXmlNode.NeedAttr(const aName: TXmlString): TXmlString; +function TXmlNode.NeedAttr(const aName: String): String; begin Result := NeedAttr(FNames.GetID(aName)) end; @@ -2293,13 +2382,13 @@ begin Result := aDefault; end; -function TXmlNode.GetVarAttr(const aName: TXmlString; +function TXmlNode.GetVarAttr(const aName: String; const aDefault: Variant): Variant; begin Result := GetVarAttr(FNames.GetID(aName), aDefault) end; -function TXmlNode.Get_NodeName: TXmlString; +function TXmlNode.Get_NodeName: String; begin Result := FNames.GetName(Get_NodeNameID); end; @@ -2353,7 +2442,7 @@ begin Result := Get_Text end; -function TXmlNode.Get_XML: TXmlString; +function TXmlNode.Get_XML: String; var anXml: TStringBuilder; begin @@ -2386,7 +2475,7 @@ begin FChilds.ClearNodes end; -procedure TXmlNode.RemoveAttr(const aName: TXmlString); +procedure TXmlNode.RemoveAttr(const aName: String); begin RemoveAttr(FNames.GetID(aName)); end; @@ -2396,6 +2485,10 @@ var a1, a2: PXmlAttrData; i: Integer; begin + if FAttrCount = 0 then begin + Exit; + end; + a1 := @FAttrs[0]; i := 0; while (i < FAttrCount) and (a1.NameID <> aNameID) do begin @@ -2432,26 +2525,18 @@ begin aChilds.ReplaceNode(i, aNewChild.GetObject as TXmlNode) end; -function NameCanBeginWith(aChar: TXmlChar): Boolean; +function NameCanBeginWith(aChar: Char): Boolean; begin - {$IFDEF XML_WIDE_CHARS} - Result := (aChar = '_') or IsCharAlphaW(aChar) - {$ELSE} Result := (aChar = '_') or IsCharAlpha(aChar) - {$ENDIF} end; -function NameCanContain(aChar: TXmlChar): Boolean; +function NameCanContain(aChar: Char): Boolean; begin - {$IFDEF XML_WIDE_CHARS} Result := (aChar = '_') or (aChar = '-') or (aChar = ':') or (aChar = '.') or - IsCharAlphaNumericW(aChar) - {$ELSE} - Result := (aChar in ['_', '-', ':', '.']) or IsCharAlphaNumeric(aChar) - {$ENDIF} + IsCharAlphaNumeric(aChar) end; -function IsName(const s: TXmlString): Boolean; +function IsName(const s: String): Boolean; var i: Integer; begin @@ -2494,7 +2579,7 @@ type function TXmlNode.SelectNodes( - const anExpression: TXmlString): IXmlNodeList; + const anExpression: String): IXmlNodeList; var aNodes: TXmlNodeList; aChilds: TXmlNodeList; @@ -2548,8 +2633,7 @@ begin end; end; -function TXmlNode.SelectSingleNode( - const anExpression: TXmlString): IXmlNode; +function TXmlNode.SelectSingleNode(const anExpression: String): IXmlNode; var aChilds: TXmlNodeList; aChild: TXmlNode; @@ -2574,8 +2658,7 @@ begin end end; -function TXmlNode.FindElement(const anElementName, anAttrName: String; - const anAttrValue: Variant): IXmlElement; +function TXmlNode.FindElement(const anElementName, anAttrName: String; const anAttrValue: Variant): IXmlElement; var aChild: TXmlNode; aNameID, anAttrNameID: Integer; @@ -2642,20 +2725,14 @@ begin Set_Text(aValue) end; -function GetVarVal(aValue: TXmlString): Variant; +procedure TXmlNode.SetAttr(const aName, aValue: String); begin - if aValue = XSTR_NULL then Result := null - else Result := aValue + SetVarAttr(FNames.GetID(aName), aValue) end; -procedure TXmlNode.SetAttr(const aName, aValue: TXmlString); +procedure TXmlNode.SetAttr(aNameID: Integer; const aValue: String); begin - SetVarAttr(FNames.GetID(aName), GetVarVal(aValue)) -end; - -procedure TXmlNode.SetAttr(aNameID: Integer; const aValue: TXmlString); -begin - SetVarAttr(aNameID, GetVarVal(aValue)) + SetVarAttr(aNameID, aValue) end; procedure TXmlNode.SetBoolAttr(aNameID: Integer; aValue: Boolean); @@ -2663,18 +2740,18 @@ begin SetVarAttr(aNameID, aValue) end; -procedure TXmlNode.SetBoolAttr(const aName: TXmlString; aValue: Boolean); +procedure TXmlNode.SetBoolAttr(const aName: String; aValue: Boolean); begin SetVarAttr(FNames.GetID(aName), aValue) end; -procedure TXmlNode.SetChildText(const aName: TXmlString; - const aValue: TXmlString); +procedure TXmlNode.SetChildText(const aName: String; + const aValue: String); begin SetChildText(FNames.GetID(aName), aValue) end; -procedure TXmlNode.SetChildText(aNameID: Integer; const aValue: TXmlString); +procedure TXmlNode.SetChildText(aNameID: Integer; const aValue: String); var aChild: TXmlNode; begin @@ -2692,12 +2769,12 @@ begin SetVarAttr(aNameID, aValue) end; -procedure TXmlNode.SetFloatAttr(const aName: TXmlString; aValue: Double); +procedure TXmlNode.SetFloatAttr(const aName: String; aValue: Double); begin SetVarAttr(FNames.GetID(aName), aValue); end; -procedure TXmlNode.SetHexAttr(const aName: TXmlString; aValue, +procedure TXmlNode.SetHexAttr(const aName: String; aValue, aDigits: Integer); begin SetVarAttr(FNames.GetID(aName), IntToHex(aValue, aDigits)) @@ -2713,12 +2790,12 @@ begin SetVarAttr(aNameID, aValue) end; -procedure TXmlNode.SetIntAttr(const aName: TXmlString; aValue: Integer); +procedure TXmlNode.SetIntAttr(const aName: String; aValue: Integer); begin SetVarAttr(FNames.GetID(aName), aValue) end; -procedure TXmlNode.SetVarAttr(const aName: TXmlString; aValue: Variant); +procedure TXmlNode.SetVarAttr(const aName: String; aValue: Variant); begin SetVarAttr(FNames.GetID(aName), aValue) end; @@ -2754,12 +2831,20 @@ function TXmlNode.FindAttrData(aNameID: Integer): PXmlAttrData; var i: Integer; begin + if FAttrCount = 0 then begin + Result := nil; + Exit; + end; + Result := @FAttrs[0]; - for i := 0 to FAttrCount - 1 do - if Result.NameID = aNameID then + for i := 0 to FAttrCount - 1 do begin + if Result.NameID = aNameID then begin Exit - else + end + else begin Inc(Result); + end; + end; Result := nil; end; @@ -2770,7 +2855,7 @@ end; function TXmlNode.AsCDATASection: IXmlCDATASection; begin - Result := nil + Result := nil end; function TXmlNode.AsComment: IXmlComment; @@ -2788,7 +2873,7 @@ begin Result := nil end; -function TXmlNode.AppendCDATA(const aData: TXmlString): IXmlCDATASection; +function TXmlNode.AppendCDATA(const aData: String): IXmlCDATASection; var aChild: TXmlCDATASection; begin @@ -2797,7 +2882,7 @@ begin Result := aChild end; -function TXmlNode.AppendComment(const aData: TXmlString): IXmlComment; +function TXmlNode.AppendComment(const aData: String): IXmlComment; var aChild: TXmlComment; begin @@ -2806,7 +2891,7 @@ begin Result := aChild end; -function TXmlNode.AppendElement(const aName: TxmlString): IXmlElement; +function TXmlNode.AppendElement(const aName: String): IXmlElement; var aChild: TXmlElement; begin @@ -2825,7 +2910,7 @@ begin end; function TXmlNode.AppendProcessingInstruction(const aTarget, - aData: TXmlString): IXmlProcessingInstruction; + aData: String): IXmlProcessingInstruction; var aChild: TXmlProcessingInstruction; begin @@ -2835,7 +2920,7 @@ begin end; function TXmlNode.AppendProcessingInstruction(aTargetID: Integer; - const aData: TXmlString): IXmlProcessingInstruction; + const aData: String): IXmlProcessingInstruction; var aChild: TXmlProcessingInstruction; begin @@ -2844,7 +2929,7 @@ begin Result := aChild end; -function TXmlNode.AppendText(const aData: TXmlString): IXmlText; +function TXmlNode.AppendText(const aData: String): IXmlText; var aChild: TXmlText; begin @@ -2867,7 +2952,7 @@ begin end; end; -procedure TXmlNode.LoadBinXml(aReader: TBinXmlReader); +procedure TXmlNode.LoadBinXml(aReader: TBinaryXmlReader); var aCount: LongInt; a: PXmlAttrData; @@ -2878,12 +2963,14 @@ begin aCount := aReader.ReadLongint; SetLength(FAttrs, aCount); FAttrCount := aCount; - a := @FAttrs[0]; - for i := 0 to aCount - 1 do begin - a.NameID := aReader.ReadLongint; - aReader.ReadVariant(TVarData(a.Value)); - Inc(a); - end; + if aCount > 0 then begin + a := @FAttrs[0]; + for i := 0 to aCount - 1 do begin + a.NameID := aReader.ReadLongint; + aReader.ReadVariant(TVarData(a.Value)); + Inc(a); + end; + end; // Считать дочерние узлы aCount := aReader.ReadLongint; @@ -2891,7 +2978,7 @@ begin GetChilds.LoadBinXml(aReader, aCount, FNames); end; -procedure TXmlNode.SaveBinXml(aWriter: TBinXmlWriter); +procedure TXmlNode.SaveBinXml(aWriter: TBinaryXmlWriter); var aCount: LongInt; a: PXmlAttrData; @@ -2900,12 +2987,14 @@ begin // Считать атрибуты aCount := FAttrCount; aWriter.WriteLongint(aCount); - a := @FAttrs[0]; - for i := 0 to aCount - 1 do begin - aWriter.WriteLongint(a.NameID); - aWriter.WriteVariant(TVarData(a.Value)); - Inc(a); - end; + if aCount > 0 then begin + a := @FAttrs[0]; + for i := 0 to aCount - 1 do begin + aWriter.WriteLongint(a.NameID); + aWriter.WriteVariant(TVarData(a.Value)); + Inc(a); + end; + end; // Записать дочерние узлы if Assigned(FChilds) then begin @@ -2918,11 +3007,7 @@ end; function TXmlNode.Get_DataType: Integer; begin - {$IFDEF XML_WIDE_CHARS} - Result := varOleStr - {$ELSE} Result := varString - {$ENDIF} end; function TXmlNode.AttrExists(aNameID: Integer): Boolean; @@ -2930,7 +3015,7 @@ begin Result := FindAttrData(aNameID) <> nil end; -function TXmlNode.AttrExists(const aName: TXmlString): Boolean; +function TXmlNode.AttrExists(const aName: String): Boolean; begin Result := FindAttrData(FNames.GetID(aName)) <> nil end; @@ -2940,17 +3025,15 @@ var a: PXmlAttrData; begin a := FindAttrData(aNameID); - if Assigned(a) then + if Assigned(a) then begin Result := TVarData(a.Value).VType - else - {$IFDEF XML_WIDE_CHARS} - Result := varOleStr - {$ELSE} + end + else begin Result := varString - {$ENDIF} + end; end; -function TXmlNode.GetAttrType(const aName: TXmlString): Integer; +function TXmlNode.GetAttrType(const aName: String): Integer; begin Result := GetAttrType(FNames.GetID(aName)); end; @@ -3004,7 +3087,7 @@ begin Result := aDefault; end; -function TXmlNode.GetDateTimeAttr(const aName: TXmlString; +function TXmlNode.GetDateTimeAttr(const aName: String; aDefault: TDateTime): TDateTime; begin Result := GetDateTimeAttr(FNames.GetID(aName), aDefault) @@ -3015,7 +3098,7 @@ begin SetVarAttr(aNameID, VarAsType(aValue, varDate)) end; -procedure TXmlNode.SetDateTimeAttr(const aName: TXmlString; +procedure TXmlNode.SetDateTimeAttr(const aName: String; aValue: TDateTime); begin SetVarAttr(aName, VarAsType(aValue, varDate)) @@ -3032,7 +3115,7 @@ begin Result := AppendElement(aNameID) end; -function TXmlNode.EnsureChild(const aName: TXmlString): IXmlNode; +function TXmlNode.EnsureChild(const aName: String): IXmlNode; begin Result := EnsureChild(FNames.GetID(aName)) end; @@ -3047,7 +3130,7 @@ begin Result := aChild end; -function TXmlNode.NeedChild(const aName: TXmlString): IXmlNode; +function TXmlNode.NeedChild(const aName: String): IXmlNode; begin Result := NeedChild(FNames.GetID(aName)); end; @@ -3104,12 +3187,12 @@ begin Result := FSourceCol end; -function TXmlNode.GetTextAsBynaryData: TXmlString; +function TXmlNode.GetTextAsBinaryData: RawByteString; begin Result := Base64ToBin(Get_Text); end; -function TXmlNode.GetOwnText: TXmlString; +function TXmlNode.GetOwnText: String; var i: Integer; sb: TStringBuilder; @@ -3122,7 +3205,7 @@ begin sb.GetString(Result); end; -procedure TXmlNode.ReplaceTextByBynaryData(const aData; aSize: Integer; +procedure TXmlNode.ReplaceTextByBinaryData(const aData; aSize: Integer; aMaxLineLength: Integer); begin RemoveTextNodes; @@ -3142,9 +3225,9 @@ begin end; end; -procedure TXmlNode.ReplaceTextByCDATASection(const aText: TXmlString); +procedure TXmlNode.ReplaceTextByCDATASection(const aText: String); - procedure AddCDATASection(const aText: TXmlString); + procedure AddCDATASection(const aText: String); var i: Integer; aChilds: TXmlNodeList; @@ -3195,11 +3278,11 @@ begin end; end; -function TXmlElement.Get_Text: TXmlString; +function TXmlElement.Get_Text: String; var aChilds: TXmlNodeList; aChild: TXmlNode; - aChildText: TXmlString; + aChildText: String; i: Integer; begin Result := ''; @@ -3223,7 +3306,7 @@ begin Result := VarToXSTR(TVarData(FData)) end; -procedure TXmlElement.Set_Text(const aValue: TXmlString); +procedure TXmlElement.Set_Text(const aValue: String); begin if Assigned(FChilds) then FChilds.ClearNodes; @@ -3271,7 +3354,7 @@ procedure TXmlElement.GetXML(var anXml: TStringBuilder); var aChildsXMLSB: TStringBuilder; aChildsXML: String; - aTag: TXmlString; + aTag: String; aDoc: TXmlDocument; aPreserveWhiteSpace: Boolean; aSaveLength: Integer; @@ -3360,14 +3443,12 @@ end; function TXmlElement.Get_DataType: Integer; begin - if (Assigned(FChilds) and (FChilds.FCount > 0)) or VarIsEmpty(FData) then - {$IFDEF XML_WIDE_CHARS} - Result := varOleStr - {$ELSE} + if (Assigned(FChilds) and (FChilds.FCount > 0)) or VarIsEmpty(FData) then begin Result := varString - {$ENDIF} - else + end + else begin Result := TVarData(FData).VType; + end; end; function TXmlElement.Get_ChildNodes: IXmlNodeList; @@ -3400,13 +3481,13 @@ end; { TXmlCharacterData } constructor TXmlCharacterData.Create(aNames: TXmlNameTable; - const aData: TXmlString); + const aData: String); begin inherited Create(aNames); FData := aData; end; -function TXmlCharacterData.Get_Text: TXmlString; +function TXmlCharacterData.Get_Text: String; var aDoc: TXmlDocument; aPreserveWhiteSpace: Boolean; @@ -3422,7 +3503,7 @@ begin Result := Trim(FData); end; -procedure TXmlCharacterData.Set_Text(const aValue: TXmlString); +procedure TXmlCharacterData.Set_Text(const aValue: String); begin FData := aValue end; @@ -3460,7 +3541,7 @@ begin Result := NODE_TEXT end; -function TXmlText.Get_Text: TXmlString; +function TXmlText.Get_Text: String; begin Result := VarToXSTR(TVarData(FData)) end; @@ -3475,7 +3556,7 @@ begin anXml.Add(TextToXML(VarToXSTR(TVarData(FData)))); end; -procedure TXmlText.Set_Text(const aValue: TXmlString); +procedure TXmlText.Set_Text(const aValue: String); begin FData := aValue end; @@ -3507,7 +3588,7 @@ begin Result := NODE_CDATA_SECTION end; -function GenCDATAXML(const aValue: TXmlString): TXmlString; +function GenCDATAXML(const aValue: String): String; var i: Integer; begin @@ -3561,12 +3642,12 @@ begin end; function TXmlDocument.CreateCDATASection( - const aData: TXmlString): IXmlCDATASection; + const aData: String): IXmlCDATASection; begin Result := TXmlCDATASection.Create(FNames, aData) end; -function TXmlDocument.CreateComment(const aData: TXmlString): IXmlComment; +function TXmlDocument.CreateComment(const aData: String): IXmlComment; begin Result := TXmlComment.Create(FNames, aData) end; @@ -3576,24 +3657,24 @@ begin Result := TXmlElement.Create(FNames, aNameID) end; -function TXmlDocument.CreateElement(const aName: TXmlString): IXmlElement; +function TXmlDocument.CreateElement(const aName: String): IXmlElement; begin Result := TXmlElement.Create(FNames, FNames.GetID(aName)); end; function TXmlDocument.CreateProcessingInstruction(const aTarget, - aData: TXmlString): IXmlProcessingInstruction; + aData: String): IXmlProcessingInstruction; begin Result := TXmlProcessingInstruction.Create(FNames, FNames.GetID(aTarget), aData) end; function TXmlDocument.CreateProcessingInstruction(aTargetID: Integer; - const aData: TXmlString): IXmlProcessingInstruction; + const aData: String): IXmlProcessingInstruction; begin Result := TXmlProcessingInstruction.Create(FNames, aTargetID, aData) end; -function TXmlDocument.CreateText(const aData: TXmlString): IXmlText; +function TXmlDocument.CreateText(const aData: String): IXmlText; begin Result := TXmlText.Create(FNames, aData) end; @@ -3610,11 +3691,11 @@ begin aClone.AppendChild(FChilds.FItems[i].CloneNode(True)); end; -function TXmlDocument.Get_BinaryXML: String; +function TXmlDocument.Get_BinaryXML: RawByteString; var - aWriter: TStrXmlWriter; + aWriter: TRawByteStringBinaryXmlWriter; begin - aWriter := TStrXmlWriter.Create(0, $10000); + aWriter := TRawByteStringBinaryXmlWriter.Create(0, $10000); try FNames.SaveBinXml(aWriter); SaveBinXml(aWriter); @@ -3657,11 +3738,11 @@ begin Result := FPreserveWhiteSpace; end; -function TXmlDocument.Get_Text: TXmlString; +function TXmlDocument.Get_Text: String; var aChilds: TXmlNodeList; aChild: TXmlNode; - aChildText: TXmlString; + aChildText: String; i: Integer; begin Result := ''; @@ -3686,9 +3767,9 @@ end; procedure TXmlDocument.Load(aStream: TStream); var - anXml: TXmlStmSource; - aBinarySign: String; - aReader: TBinXmlReader; + anXml: TAnsiStreamXmlSource; + aBinarySign: RawByteString; + aReader: TBinaryXmlReader; begin RemoveAllChilds; RemoveAllAttrs; @@ -3699,7 +3780,7 @@ begin FNames._Release; FNames := TXmlNameTable.Create(4096); FNames._AddRef; - aReader := TStmXmlReader.Create(aStream, $10000); + aReader := TStreamBinaryXmlReader.Create(aStream, $10000); try FNames.LoadBinXml(aReader); LoadBinXml(aReader); @@ -3710,7 +3791,7 @@ begin end; aStream.Position := aStream.Position - BinXmlSignatureSize; end; - anXml := TXmlStmSource.Create(aStream, 1 shl 16); + anXml := TAnsiStreamXmlSource.Create(aStream, 1 shl 16); try GetChilds.ParseXML(anXml, FNames, FPreserveWhiteSpace); finally @@ -3718,11 +3799,11 @@ begin end end; -procedure TXmlDocument.Load(const aFileName: TXmlString); +procedure TXmlDocument.Load(const aFileName: String); var aFile: TFileStream; begin - aFile := TFileStream.Create(aFileName, fmOpenRead, fmShareDenyWrite); + aFile := TFileStream.Create(aFileName, fmOpenRead or fmShareDenyWrite, fmShareDenyWrite); try try Load(aFile); @@ -3737,13 +3818,13 @@ begin end end; -procedure TXmlDocument.LoadBinaryXML(const anXml: String); +procedure TXmlDocument.LoadBinaryXML(const anXml: RawByteString); var - aReader: TStrXmlReader; + aReader: TRawByteStringBinaryXmlReader; begin RemoveAllChilds; RemoveAllAttrs; - aReader := TStrXmlReader.Create(anXml); + aReader := TRawByteStringBinaryXmlReader.Create(anXml); try FNames._Release; FNames := TXmlNameTable.Create(4096); @@ -3782,16 +3863,31 @@ begin end; end; -procedure TXmlDocument.LoadXML(const anXml: TXmlString); +procedure TXmlDocument.LoadXML(const anXml: String); var - aSource: TXmlStrSource; + aSource: TStringXmlSource; begin - if XmlIsInBinaryFormat(anXml) then + RemoveAllChilds; + RemoveAllAttrs; + aSource := TStringXmlSource.Create(anXml); + try + GetChilds.ParseXML(aSource, FNames, FPreserveWhiteSpace); + finally + aSource.Free + end +end; + +procedure TXmlDocument.LoadXML(const anXml: RawByteString); +var + aSource: TStringXmlSource; +begin + if XmlIsInBinaryFormat(anXml) then begin LoadBinaryXML(anXml) + end else begin RemoveAllChilds; RemoveAllAttrs; - aSource := TXmlStrSource.Create(anXml); + aSource := TStringXmlSource.Create(String(anXml)); try GetChilds.ParseXML(aSource, FNames, FPreserveWhiteSpace); finally @@ -3801,12 +3897,12 @@ begin end; function TXmlDocument.NewDocument(const aVersion, anEncoding, - aRootElementName: TXmlString): IXmlElement; + aRootElementName: String): IXmlElement; begin Result := NewDocument(aVersion, anEncoding, FNames.GetID(aRootElementName)); end; -function TXmlDocument.NewDocument(const aVersion, anEncoding: TXmlString; +function TXmlDocument.NewDocument(const aVersion, anEncoding: String; aRootElementNameID: Integer): IXmlElement; var aChilds: TXmlNodeList; @@ -3831,16 +3927,24 @@ var anXml: TStringBuilder; begin anXml.Init; - GetXML(anXml); - if anXml.FLength > 0 then - aStream.WriteBuffer(anXml.FData[1], sizeof(TXmlChar)*anXml.FLength); + GetXML(anXml); + if anXml.FLength > 0 then begin + aStream.WriteBuffer(anXml.FData[1], sizeof(Char)*anXml.FLength); + end; end; -procedure TXmlDocument.Save(const aFileName: TXmlString); +procedure TXmlDocument.Save(const aFileName: String); var aFile: TFileStream; begin - aFile := TFileStream.Create(aFileName, fmCreate, fmShareDenyWrite); + if FileExists(aFileName) then begin + aFile := TFileStream.Create(aFileName, fmOpenWrite or fmShareDenyWrite); + aFile.Size := 0; + end + else begin + aFile := TFileStream.Create(aFileName, fmCreate); + end; + try Save(aFile); finally @@ -3850,9 +3954,9 @@ end; procedure TXmlDocument.SaveBinary(aStream: TStream; anOptions: LongWord); var - aWriter: TBinXmlWriter; + aWriter: TBinaryXmlWriter; begin - aWriter := TStmXmlWriter.Create(aStream, anOptions, 65536); + aWriter := TStreamBinrayXmlWriter.Create(aStream, anOptions, 65536); try FNames.SaveBinXml(aWriter); SaveBinXml(aWriter); @@ -3861,11 +3965,11 @@ begin end end; -procedure TXmlDocument.SaveBinary(const aFileName: TXmlString; anOptions: LongWord); +procedure TXmlDocument.SaveBinary(const aFileName: String; anOptions: LongWord); var aFile: TFileStream; begin - aFile := TFileStream.Create(aFileName, fmCreate, fmShareDenyWrite); + aFile := TFileStream.Create(aFileName, fmCreate or fmShareDenyWrite); try SaveBinary(aFile, anOptions); finally @@ -3878,7 +3982,7 @@ begin FPreserveWhiteSpace := aValue; end; -procedure TXmlDocument.Set_Text(const aText: TXmlString); +procedure TXmlDocument.Set_Text(const aText: String); var aChilds: TXmlNodeList; begin @@ -3895,7 +3999,7 @@ begin end; constructor TXmlProcessingInstruction.Create(aNames: TXmlNameTable; - aTargetID: Integer; const aData: TXmlString); + aTargetID: Integer; const aData: String); begin inherited Create(aNames); FTargetID := aTargetID; @@ -3917,19 +4021,24 @@ begin Result := NODE_PROCESSING_INSTRUCTION end; -function TXmlProcessingInstruction.Get_Text: TXmlString; +function TXmlProcessingInstruction.Get_Text: String; begin Result := FData; end; procedure TXmlProcessingInstruction.GetXML(var anXml: TStringBuilder); begin - anXml.Add(''); + anXml.Add('?>'); +end; + +function TXmlProcessingInstruction.Get_Target: String; +begin + Result := FNames.GetName(FTargetID); end; procedure TXmlProcessingInstruction.SetNodeNameID(aValue: Integer); @@ -3937,18 +4046,18 @@ begin FTargetID := aValue end; -procedure TXmlProcessingInstruction.Set_Text(const aText: TXmlString); +procedure TXmlProcessingInstruction.Set_Text(const aText: String); begin FData := aText end; { TXmlStrSource } -constructor TXmlStrSource.Create(const aSource: TXmlString); +constructor TStringXmlSource.Create(const aSource: String); begin inherited Create; FSource := aSource; - FSourcePtr := PXmlChar(FSource); + FSourcePtr := PChar(FSource); FSourceEnd := FSourcePtr + Length(FSource); if FSourcePtr = FSourceEnd then CurChar := #0 @@ -3956,12 +4065,12 @@ begin CurChar := FSourcePtr^; end; -function TXmlStrSource.EOF: Boolean; +function TStringXmlSource.EOF: Boolean; begin Result := FSourcePtr = FSourceEnd end; -function TXmlStrSource.DoNext: Boolean; +function TStringXmlSource.DoNext: Boolean; begin if FSourcePtr < FSourceEnd then Inc(FSourcePtr); @@ -3991,11 +4100,12 @@ begin end end; -function TXmlSource.AcceptToken: TXmlString; +function TXmlSource.AcceptToken: String; begin SetLength(Result, FToken.FValuePtr - FToken.ValueStart); - if Length(Result) > 0 then - Move(FToken.ValueStart^, Result[1], Length(Result)*sizeof(TXmlChar)); + if Length(Result) > 0 then begin + Move(FToken.ValueStart^, Result[1], Length(Result)*sizeof(Char)); + end; DropToken; end; @@ -4003,14 +4113,13 @@ function TXmlSource.Next: Boolean; begin Result := DoNext; if Result then begin - if (CurChar = ^M) or - (CurChar = ^J) and (FPrevChar <> ^M) and (FPrevChar <> ^J) - then begin + if (CurChar = ^M) or (CurChar = ^J) and (FPrevChar <> ^M) and (FPrevChar <> ^J) then begin Inc(FCurLine); FCurPos := 0; end - else if CurChar <> ^J then + else if CurChar <> ^J then begin Inc(FCurPos); + end; FPrevChar := CurChar; end; end; @@ -4023,7 +4132,7 @@ end; // на входе - первый символ имени // на выходе - первый символ, который не является допустимым для имен -function TXmlSource.ExpectXmlName: TXmlString; +function TXmlSource.ExpectXmlName: String; begin if not NameCanBeginWith(CurChar) then raise Exception.CreateFmt(SSimpleXmlError11, [FCurLine, FCurPos]); @@ -4038,7 +4147,7 @@ end; // на выходе - первый символ, который не является допустимым для чисел function TXmlSource.ExpectDecimalInteger: Integer; var - s: TXmlString; + s: String; e: Integer; begin NewToken; @@ -4052,81 +4161,92 @@ begin Val(s, Result, e); end; +function IsHexDigit(c: Char): Boolean; +begin + Result := (c >= '0') and (c <= '9') or (c >= 'A') and (c <= 'F') or (c >= 'a') and (c <= 'f') +end; + // на входе - первый символ числа // на выходе - первый символ, который не является допустимым для // щестнадцатиричных чисел function TXmlSource.ExpectHexInteger: Integer; var - s: TXmlString; + s: String; e: Integer; begin NewToken; - {$IFDEF XML_WIDE_CHARS} - while (CurChar >= '0') and (CurChar <= '9') or - (CurChar >= 'A') and (CurChar <= 'F') or - (CurChar >= 'a') and (CurChar <= 'f') do begin - {$ELSE} - while CurChar in ['0'..'9', 'A'..'F', 'a'..'f'] do begin - {$ENDIF} + while IsHexDigit(CurChar) do begin AppendTokenChar(CurChar); Next; end; s := '$'; s := s + AcceptToken; - if Length(s) = 1 then + if Length(s) = 1 then begin raise Exception.CreateFmt(SSimpleXmlError13, [FCurLine, FCurPos]); + end; Val(s, Result, e); end; // на входе: "&" // на выходе: следующий за ";" -function TXmlSource.ExpectXmlEntity: TXmlChar; +function TXmlSource.ExpectXmlEntity: Char; var - s: TXmlString; + s: String; begin - if not Next then + if not Next then begin raise Exception.CreateFmt(SSimpleXmlError14, [FCurLine, FCurPos]); + end; if CurChar = '#' then begin - if not Next then + if not Next then begin raise Exception.CreateFmt(SSimpleXmlError12, [FCurLine, FCurPos]); + end; if CurChar = 'x' then begin Next; - Result := TXmlChar(ExpectHexInteger); + Result := Char(ExpectHexInteger); end - else - Result := TXmlChar(ExpectDecimalInteger); + else begin + Result := Char(ExpectDecimalInteger); + end; ExpectChar(';'); end else begin s := ExpectXmlName; ExpectChar(';'); - if s = 'amp' then + if s = 'amp' then begin Result := '&' - else if s = 'quot' then + end + else if s = 'quot' then begin Result := '"' - else if s = 'lt' then + end + else if s = 'lt' then begin Result := '<' - else if s = 'gt' then + end + else if s = 'gt' then begin Result := '>' - else if s = 'apos' then + end + else if s = 'apos' then begin Result := '''' - else + end + else begin raise Exception.CreateFmt(SSimpleXmlError15, [FCurLine, FCurPos]); + end; end end; -procedure TXmlSource.ExpectChar(aChar: TXmlChar); +procedure TXmlSource.ExpectChar(aChar: Char); begin - if EOF or (CurChar <> aChar) then + if EOF or (CurChar <> aChar) then begin raise Exception.CreateFmt(SSimpleXmlError16, [aChar, FCurLine, FCurPos]); + end; Next; end; -procedure TXmlSource.ExpectText(aText: PXmlChar); +procedure TXmlSource.ExpectText(aText: PChar); begin while aText^ <> #0 do begin - if (CurChar <> aText^) or EOF then + if (CurChar <> aText^) or EOF then begin raise Exception.CreateFmt(SSimpleXmlError17, [aText, FCurLine, FCurPos]); + end; Inc(aText); Next; end; @@ -4134,30 +4254,33 @@ end; // на входе: открывающая кавычка // на выходе: символ, следующий за закрывающей кавычкой -function TXmlSource.ExpectQuotedText(aQuote: TXmlChar): TXmlString; +function TXmlSource.ExpectQuotedText(aQuote: Char): String; begin NewToken; Next; while not EOF and (CurChar <> aQuote) do begin - if CurChar = '&' then + if CurChar = '&' then begin AppendTokenChar(ExpectXmlEntity) - else if CurChar = '<' then + end + else if CurChar = '<' then begin raise Exception.CreateFmt(SSimpleXmlError18, [FCurLine, FCurPos]) + end else begin AppendTokenChar(CurChar); Next; end end; - if EOF then + if EOF then begin raise Exception.CreateFmt(SimpleXmlError19, [aQuote, FCurLine, FCurPos]); + end; Next; Result := AcceptToken; end; procedure TXmlSource.ParseAttrs(aNode: TXmlNode); var - aName: TXmlString; - aValue: TXmlString; + aName: String; + aValue: String; begin SkipBlanks; while not EOF and NameCanBeginWith(CurChar) do begin @@ -4165,20 +4288,22 @@ begin SkipBlanks; ExpectChar('='); SkipBlanks; - if EOF then + if EOF then begin raise Exception.CreateFmt(SSimpleXmlError20, [FCurLine, FCurPos]); - if (CurChar = '''') or (CurChar = '"') then + end; + if (CurChar = '''') or (CurChar = '"') then begin aValue := ExpectQuotedText(CurChar) - else + end + else begin raise Exception.CreateFmt(SSimpleXmlError21, [FCurLine, FCurPos]); + end; aNode.SetAttr(aName, aValue); SkipBlanks; end; end; -function StrEquals(p1, p2: PXmlChar; aLen: Integer): Boolean; +function StrEquals(p1, p2: PChar; aLen: Integer): Boolean; begin - {$IFDEF XML_WIDE_CHARS} while aLen > 0 do if p1^ <> p2^ then begin Result := False; @@ -4194,17 +4319,14 @@ begin Dec(aLen); end; Result := True; - {$ELSE} - Result := StrLComp(p1, p2, aLen) = 0 - {$ENDIF} end; // на входе: первый символ текста // на выходе: символ, следующий за последним символом ограничителя -function TXmlSource.ParseTo(aText: PXmlChar): TXmlString; +function TXmlSource.ParseTo(aText: PChar): String; var - aCheck: PXmlChar; - p: PXmlChar; + aCheck: PChar; + p: PChar; begin NewToken; aCheck := aText; @@ -4223,24 +4345,27 @@ begin end else begin p := aText + 1; - while (p < aCheck) and not StrEquals(p, aText, aCheck - p) do + while (p < aCheck) and not StrEquals(p, aText, aCheck - p) do begin Inc(p); + end; AppendTokenText(aText, p - aText); - if p < aCheck then + if p < aCheck then begin aCheck := p - else + end + else begin aCheck := aText; + end; end; end; raise Exception.CreateFmt(SimpleXmlError22, [aText, FCurLine, FCurPos]); end; -procedure TXmlSource.AppendTokenChar(aChar: TXmlChar); +procedure TXmlSource.AppendTokenChar(aChar: Char); begin FToken.AppendChar(aChar); end; -procedure TXmlSource.AppendTokenText(aText: PXmlChar; aCount: Integer); +procedure TXmlSource.AppendTokenText(aText: PChar; aCount: Integer); begin FToken.AppendText(aText, aCount) end; @@ -4248,10 +4373,12 @@ end; procedure TXmlSource.DropToken; begin Dec(FTokenStackTop); - if FTokenStackTop >= 0 then + if FTokenStackTop >= 0 then begin FToken := FTokenStack[FTokenStackTop] - else + end + else begin FToken := nil + end; end; constructor TXmlSource.Create; @@ -4264,21 +4391,22 @@ destructor TXmlSource.Destroy; var i: Integer; begin - for i := 0 to Length(FTokenStack) - 1 do + for i := 0 to Length(FTokenStack) - 1 do begin FTokenStack[i].Free; + end; inherited; end; { TXmlToken } -procedure TXmlToken.AppendChar(aChar: TXmlChar); +procedure TXmlToken.AppendChar(aChar: Char); var aSaveLength: Integer; begin if FValuePtr >= FValueEnd then begin aSaveLength := FValuePtr - FValueStart; SetLength(FValueBuf, aSaveLength + 1); - FValueStart := PXmlChar(FValueBuf); + FValueStart := PChar(FValueBuf); FValuePtr := FValueStart + aSaveLength; FValueEnd := FValueStart + System.Length(FValueBuf); end; @@ -4286,18 +4414,18 @@ begin Inc(FValuePtr); end; -procedure TXmlToken.AppendText(aText: PXmlChar; aCount: Integer); +procedure TXmlToken.AppendText(aText: PChar; aCount: Integer); var aSaveLength: Integer; begin if (FValuePtr + aCount) > FValueEnd then begin aSaveLength := FValuePtr - FValueStart; SetLength(FValueBuf, aSaveLength + aCount); - FValueStart := PXmlChar(FValueBuf); + FValueStart := PChar(FValueBuf); FValuePtr := FValueStart + aSaveLength; FValueEnd := FValueStart + System.Length(FValueBuf); end; - Move(aText^, FValuePtr^, aCount*sizeof(TXmlChar)); + Move(aText^, FValuePtr^, aCount*sizeof(Char)); Inc(FValuePtr, aCount); end; @@ -4310,7 +4438,7 @@ constructor TXmlToken.Create; begin inherited Create; SetLength(FValueBuf, 32); - FValueStart := PXmlChar(FValueBuf); + FValueStart := PChar(FValueBuf); FValuePtr := FValueStart; FValueEnd := FValueStart + 32; end; @@ -4320,16 +4448,14 @@ begin Result := FValuePtr - FValueStart; end; -{$IFDEF XML_WIDE_CHARS} function AnsiToUnicode(c: AnsiChar): WideChar; begin MultiByteToWideChar(CP_ACP, 0, @c, 1, @Result, 1); end; -{$ENDIF} -{ TXmlStmSource } +{ TAnsiStreamXmlSource } -constructor TXmlStmSource.Create(aStream: TStream; aBufSize: Integer); +constructor TAnsiStreamXmlSource.Create(aStream: TStream; aBufSize: Integer); var aSize: Integer; begin @@ -4340,76 +4466,71 @@ begin FBufPtr := FBufStart; FBufEnd := FBufStart; FSize := aStream.Size; - if FSize = 0 then + if FSize = 0 then begin CurChar := #0 + end else begin - if FSize < FBufSize then + if FSize < FBufSize then begin aSize := FSize - else + end + else begin aSize := FBufSize; + end; FStream.ReadBuffer(FBufStart^, aSize); FBufEnd := FBufStart + aSize; FBufPtr := FBufStart; Dec(FSize, aSize); - {$IFDEF XML_WIDE_CHARS} - CurChar := AnsiToUnicode(FBufPtr^); - {$ELSE} - CurChar := FBufPtr^; - {$ENDIF} + CurChar := Char(FBufPtr^); end end; -destructor TXmlStmSource.Destroy; +destructor TAnsiStreamXmlSource.Destroy; begin FreeMem(FBufStart); inherited; end; -function TXmlStmSource.EOF: Boolean; +function TAnsiStreamXmlSource.EOF: Boolean; begin Result := (FBufPtr = FBufEnd) and (FSize = 0) end; -function TXmlStmSource.DoNext: Boolean; +function TAnsiStreamXmlSource.DoNext: Boolean; var aSize: Integer; begin - if FBufPtr < FBufEnd then + if FBufPtr < FBufEnd then begin Inc(FBufPtr); - if FBufPtr = FBufEnd then + end; + if FBufPtr = FBufEnd then begin if FSize = 0 then begin Result := False; CurChar := #0; end else begin - if FSize < FBufSize then + if FSize < FBufSize then begin aSize := FSize - else + end + else begin aSize := FBufSize; + end; FStream.ReadBuffer(FBufStart^, aSize); FBufEnd := FBufStart + aSize; FBufPtr := FBufStart; Dec(FSize, aSize); Result := True; - {$IFDEF XML_WIDE_CHARS} - CurChar := AnsiToUnicode(FBufPtr^); - {$ELSE} - CurChar := FBufPtr^; - {$ENDIF} + CurChar := Char(FBufPtr^); end + end else begin Result := True; - {$IFDEF XML_WIDE_CHARS} - CurChar := AnsiToUnicode(FBufPtr^); - {$ELSE} - CurChar := FBufPtr^; - {$ENDIF} + CurChar := Char(FBufPtr^); end; end; -{ TStmXmlReader } +{ TStreamBinaryXmlReader } -constructor TStmXmlReader.Create(aStream: TStream; aBufSize: Integer); +constructor TStreamBinaryXmlReader.Create(aStream: TStream; aBufSize: Integer); begin inherited Create; FStream := aStream; @@ -4421,20 +4542,21 @@ begin Read(FOptions, sizeof(FOptions)); end; -destructor TStmXmlReader.Destroy; +destructor TStreamBinaryXmlReader.Destroy; begin FreeMem(FBufStart); inherited; end; -procedure TStmXmlReader.Read(var aBuf; aSize: Integer); +procedure TStreamBinaryXmlReader.Read(var aBuf; aSize: Integer); var aBufRest: Integer; - aDst: PChar; + aDst: PAnsiChar; aBufSize: Integer; begin - if aSize > FRestSize then + if aSize > FRestSize then begin raise Exception.Create(SSimpleXmlError23); + end; aBufRest := FBufEnd - FBufPtr; if aSize <= aBufRest then begin @@ -4449,35 +4571,41 @@ begin FStream.ReadBuffer(aDst^, aSize - aBufRest); Dec(FRestSize, aSize); - if FRestSize < FBufSize then + if FRestSize < FBufSize then begin aBufSize := FRestSize - else + end + else begin aBufSize := FBufSize; + end; FBufPtr := FBufStart; FBufEnd := FBufStart + aBufSize; - if aBufSize > 0 then + if aBufSize > 0 then begin FStream.ReadBuffer(FBufStart^, aBufSize); + end; end; end; -{ TStrXmlReader } +{ TRawByteStringBinaryXmlReader } -constructor TStrXmlReader.Create(const aStr: String); +constructor TRawByteStringBinaryXmlReader.Create(const aStr: RawByteString); var - aSig: array [1..BinXmlSignatureSize] of Char; + aSig: array [1..BinXmlSignatureSize] of Byte; begin inherited Create; FString := aStr; FRestSize := Length(aStr); - FPtr := PChar(FString); + if FRestSize > 0 then begin + FPtr := @FString[1]; + end; Read(aSig, BinXmlSignatureSize); Read(FOptions, sizeof(FOptions)); end; -procedure TStrXmlReader.Read(var aBuf; aSize: Integer); +procedure TRawByteStringBinaryXmlReader.Read(var aBuf; aSize: Integer); begin - if aSize > FRestSize then + if aSize > FRestSize then begin raise Exception.Create(SSimpleXmlError23); + end; Move(FPtr^, aBuf, aSize); Inc(FPtr, aSize); Dec(FRestSize, aSize); @@ -4485,7 +4613,7 @@ end; { TBinXmlReader } -function TBinXmlReader.ReadAnsiString: String; +function TBinaryXmlReader.ReadAnsiString: AnsiString; var aLength: LongInt; begin @@ -4498,7 +4626,7 @@ begin end end; -function TBinXmlReader.ReadLongint: Longint; +function TBinaryXmlReader.ReadLongint: Longint; var b: Byte; begin @@ -4513,7 +4641,7 @@ begin end end; -procedure TBinXmlReader.ReadVariant(var v: TVarData); +procedure TBinaryXmlReader.ReadVariant(var v: TVarData); var aDataType: Word; aSize: Longint; @@ -4537,7 +4665,7 @@ begin varDate: Read(v.VDate, sizeof(TDateTime)); varOleStr: - Variant(v) := ReadWideString; + Variant(v) := ReadUnicodeString; varBoolean: Read(v.VBoolean, sizeof(WordBool)); varShortInt: @@ -4569,30 +4697,33 @@ begin v.VType := aDataType; end; -function TBinXmlReader.ReadWideString: WideString; +function TBinaryXmlReader.ReadUnicodeString: UnicodeString; var aLength: LongInt; begin aLength := ReadLongint; - if aLength = 0 then + if aLength = 0 then begin Result := '' + end else begin SetLength(Result, aLength); Read(Result[1], aLength*sizeof(WideChar)); end end; -function TBinXmlReader.ReadXmlString: TXmlString; +function TBinaryXmlReader.ReadXmlString: String; begin - if (FOptions and BINXML_USE_WIDE_CHARS) <> 0 then - Result := ReadWideString - else - Result := ReadAnsiString + if (FOptions and BINXML_USE_WIDE_CHARS) <> 0 then begin + Result := String(ReadUnicodeString) + end + else begin + Result := String(ReadAnsiString) + end; end; { TStmXmlWriter } -constructor TStmXmlWriter.Create(aStream: TStream; anOptions: LongWord; +constructor TStreamBinrayXmlWriter.Create(aStream: TStream; anOptions: LongWord; aBufSize: Integer); begin inherited Create; @@ -4606,7 +4737,7 @@ begin Write(FOptions, sizeof(FOptions)); end; -destructor TStmXmlWriter.Destroy; +destructor TStreamBinrayXmlWriter.Destroy; begin if FBufPtr > FBufStart then FStream.WriteBuffer(FBufStart^, FBufPtr - FBufStart); @@ -4614,7 +4745,7 @@ begin inherited; end; -procedure TStmXmlWriter.Write(const aBuf; aSize: Integer); +procedure TStreamBinrayXmlWriter.Write(const aBuf; aSize: Integer); var aBufRest: Integer; begin @@ -4634,7 +4765,7 @@ end; { TStrXmlWriter } -constructor TStrXmlWriter.Create(anOptions: LongWord; aBufSize: Integer); +constructor TRawByteStringBinaryXmlWriter.Create(anOptions: LongWord; aBufSize: Integer); begin inherited Create; FData := ''; @@ -4647,13 +4778,13 @@ begin Write(FOptions, sizeof(FOptions)); end; -destructor TStrXmlWriter.Destroy; +destructor TRawByteStringBinaryXmlWriter.Destroy; begin FreeMem(FBufStart); inherited; end; -procedure TStrXmlWriter.FlushBuf; +procedure TRawByteStringBinaryXmlWriter.FlushBuf; var aPrevSize: Integer; aSize: Integer; @@ -4665,7 +4796,7 @@ begin FBufPtr := FBufStart; end; -procedure TStrXmlWriter.Write(const aBuf; aSize: Integer); +procedure TRawByteStringBinaryXmlWriter.Write(const aBuf; aSize: Integer); var aBufRest: Integer; aPrevSize: Integer; @@ -4689,17 +4820,18 @@ end; { TBinXmlWriter } -procedure TBinXmlWriter.WriteAnsiString(const aValue: String); +procedure TBinaryXmlWriter.WriteAnsiString(const aValue: AnsiString); var aLength: LongInt; begin aLength := Length(aValue); WriteLongint(aLength); - if aLength > 0 then + if aLength > 0 then begin Write(aValue[1], aLength); + end; end; -procedure TBinXmlWriter.WriteLongint(aValue: Longint); +procedure TBinaryXmlWriter.WriteLongint(aValue: Longint); var b: array [0..1] of Byte; begin @@ -4708,8 +4840,9 @@ begin Write(b[0], 1); Write(aValue, SizeOf(aValue)); end - else if aValue < $80 then + else if aValue < $80 then begin Write(aValue, 1) + end else if aValue <= $7EFF then begin b[0] := (aValue shr 8) or $80; b[1] := aValue and $FF; @@ -4722,7 +4855,7 @@ begin end; end; -procedure TBinXmlWriter.WriteVariant(const v: TVarData); +procedure TBinaryXmlWriter.WriteVariant(const v: TVarData); var aSize: Integer; p: Pointer; @@ -4744,7 +4877,7 @@ begin varDate: Write(v.VDate, sizeof(TDateTime)); varOleStr: - WriteWideString(Variant(v)); + WriteUnicodeString(Variant(v)); varBoolean: Write(v.VBoolean, sizeof(WordBool)); varShortInt: @@ -4758,7 +4891,7 @@ begin varInt64: Write(v.VInt64, sizeof(Int64)); varString: - WriteAnsiString(Variant(v)); + WriteAnsiString(AnsiString(Variant(v))); varArray + varByte: begin aSize := VarArrayHighBound(Variant(v), 1) - VarArrayLowBound(Variant(v), 1) + 1; @@ -4775,29 +4908,32 @@ begin end; end; -procedure TBinXmlWriter.WriteWideString(const aValue: WideString); +procedure TBinaryXmlWriter.WriteUnicodeString(const aValue: UnicodeString); var aLength: LongInt; begin aLength := Length(aValue); WriteLongint(aLength); - if aLength > 0 then + if aLength > 0 then begin Write(aValue[1], aLength*sizeof(WideChar)); + end; end; -procedure TBinXmlWriter.WriteXmlString(const aValue: TXmlString); +procedure TBinaryXmlWriter.WriteXmlString(const aValue: String); begin - if (FOptions and BINXML_USE_WIDE_CHARS) <> 0 then - WriteWideString(aValue) - else - WriteAnsiString(aValue) + if (FOptions and BINXML_USE_WIDE_CHARS) <> 0 then begin + WriteUnicodeString(UnicodeString(aValue)) + end + else begin + WriteAnsiString(AnsiString(aValue)) + end; end; var DefaultNameTableImpl: TXmlNameTable = nil; -function CreateXmlElement(const aName: TXmlString; const aNameTable: IXmlNameTable): IXmlElement; +function CreateXmlElement(const aName: String; const aNameTable: IXmlNameTable): IXmlElement; var aNameTableImpl: TXmlNameTable; begin @@ -4822,49 +4958,81 @@ var aNameTable: TXmlNameTable; s: String; begin - if Assigned(aNames) then + if Assigned(aNames) then begin aNameTable := aNames.GetObject as TXmlNameTable - else + end + else begin aNameTable := DefaultNameTableImpl; - if anEncoding = '' then + end; + if anEncoding = '' then begin s := DefaultEncoding - else + end + else begin s := anEncoding; + end; Result := TXmlDocument.Create(aNameTable); - if aRootElementName <> '' then + if aRootElementName <> '' then begin Result.NewDocument(aVersion, anEncoding, aRootElementName); + end; end; -function LoadXmlDocumentFromXML(const anXml: TXmlString): IXmlDocument; + + + +function LoadXmlDocumentFromXml(const anXml: String): IXmlDocument; begin Result := TXmlDocument.Create(DefaultNameTableImpl); Result.LoadXML(anXml); end; -function LoadXmlDocumentFromBinaryXML(const anXml: String): IXmlDocument; + + + +function LoadXmlDocumentFromBinaryXML(const aBinaryXml: RawByteString): IXmlDocument; begin Result := TXmlDocument.Create(DefaultNameTableImpl); - Result.LoadBinaryXML(anXml); + Result.LoadBinaryXML(aBinaryXml); end; + + + function LoadXmlDocument(aStream: TStream): IXmlDocument; begin Result := TXmlDocument.Create(DefaultNameTableImpl); Result.Load(aStream); end; -function LoadXmlDocument(const aFileName: TXmlString): IXmlDocument; overload; + + + +function LoadXmlDocument(const aFileName: String): IXmlDocument; overload; begin Result := TXmlDocument.Create(DefaultNameTableImpl); Result.Load(aFileName); end; + + + function LoadXmlDocument(aResType, aResName: PChar): IXmlDocument; overload; begin Result := TXmlDocument.Create(DefaultNameTableImpl); Result.LoadResource(aResType, aResName); end; + + + +function AppendChildNodeFromXml(const aParentNode: IXmlNode; const anXml: String): IXmlNode; +begin + Result := LoadXmlDocumentFromXml(anXml).DocumentElement.CloneNode(true); + aParentNode.AppendChild(Result); +end; + + + + initialization DefaultNameTableImpl := TXmlNameTable.Create(4096); DefaultNameTable := DefaultNameTableImpl;