simplexml.pas

delphi 环境下 XML解析引擎, 支持SAX,速度飞快,共享出来了

end;

function CreateNameTable(aHashTableSize: Integer): IXmlNameTable;
begin
	Result := TXmlNameTable.Create(aHashTableSize)
end;

type
	TXmlNode = class;
	TXmlToken = class
	private
		FValueBuf: TXmlString;
		FValueStart,
		FValuePtr,
		FValueEnd: PXmlChar;
	public
		constructor Create;
		procedure Clear;
		procedure AppendChar(aChar: TXmlChar);
		procedure AppendText(aText: PXmlChar; aCount: Integer);
		function Length: Integer;

		property ValueStart: PXmlChar read FValueStart;
	end;

	TXmlSource = class
	private
		FTokenStack: array of TXmlToken;
		FTokenStackTop: Integer;
		FToken: TXmlToken;
		function ExpectQuotedText(aQuote: TXmlChar): TXmlString;
	public
		CurChar: TXmlChar;
		constructor Create;
		destructor Destroy; override;

		function EOF: Boolean; virtual; abstract;
		function Next: Boolean; virtual; abstract;

		procedure SkipBlanks;
		function ExpectXmlName: TXmlString;
		function ExpectXmlEntity: TXmlChar;
		procedure ExpectChar(aChar: TXmlChar);
		procedure ExpectText(aText: PXmlChar);
		function ExpectDecimalInteger: Integer;
		function ExpectHexInteger: Integer;
		function ParseTo(aText: PXmlChar): TXmlString;
		procedure ParseAttrs(aNode: TXmlNode);

		procedure NewToken;
		procedure AppendTokenChar(aChar: TXmlChar);
		procedure AppendTokenText(aText: PXmlChar; aCount: Integer);
		function AcceptToken: TXmlString;
		procedure DropToken;
	end;

	TXmlStrSource = class(TXmlSource)
	private
		FSource: TXmlString;
		FSourcePtr,
		FSourceEnd: PXmlChar;
	public
		constructor Create(const aSource: TXmlString);
		function EOF: Boolean; override;
		function Next: Boolean; override;
	end;

	TXmlStmSource = class(TXmlSource)
	private
		FStream: TStream;
		FBufStart,
		FBufPtr,
		FBufEnd: PChar;
		FBufSize: Integer;
		FSize: Integer;
	public
		constructor Create(aStream: TStream; aBufSize: Integer);
		function EOF: Boolean; override;
		function Next: Boolean; override;
    destructor Destroy; override;
	end;

	TXmlNodeList = class(TXmlBase, IXmlNodeList)
	private
		FOwnerNode: TXmlNode;

		FItems: array of TXmlNode;
		FCount: Integer;
		procedure Grow;
	protected
		function Get_Count: Integer;
		function Get_Item(anIndex: Integer): IXmlNode;
		function Get_XML: TXmlString;
	public
		constructor Create(anOwnerNode: TXmlNode);
		destructor Destroy; override;

		function IndexOf(aNode: TXmlNode): Integer;
		procedure ParseXML(aXML: TXmlSource; aNames: TXmlNameTable; aPreserveWhiteSpace: Boolean);

		procedure LoadBinXml(aReader: TBinXmlReader; aCount: Integer; aNames: TXmlNameTable);
		procedure SaveBinXml(aWriter: TBinXmlWriter);

		procedure Insert(aNode: TXmlNode; anIndex: Integer);
		function Remove(aNode: TXmlNode): Integer;
		procedure Delete(anIndex: Integer);
		procedure Replace(anIndex: Integer; aNode: TXmlNode);
		procedure Clear;
	end;

	PXmlAttrData = ^TXmlAttrData;
	TXmlAttrData = record
		NameID: Integer;
		Value: Variant;
	end;

	TXmlDocument = class;
	TXmlNode = class(TXmlBase, IXmlNode)
	private
		FParentNode: TXmlNode;
		// FNames - 蜞犭桷?桁屙. 青溧弪? 桤忭?
		FNames: TXmlNameTable;
		// 暑腓麇耱忸 囹痂狍蝾??爨耨桠?FAttrs
		FAttrCount: Integer;
		// 锑耨桠 囹痂狍蝾?
		FAttrs: array of TXmlAttrData;
		// 扬桉铌 漕麇痦桴 箸腩?
		FChilds: TXmlNodeList;
		function GetChilds: TXmlNodeList; virtual;
		function FindFirstChild(aNameID: Integer): TXmlNode;
		function GetAttrsXML: TXmlString;
		function FindAttrData(aNameID: Integer): PXmlAttrData;
		function GetOwnerDocument: TXmlDocument;
		procedure SetNameTable(aValue: TXmlNameTable; aMap: TList);
		procedure SetNodeNameID(aValue: Integer); virtual;
    function DoCloneNode(aDeep: Boolean): IXmlNode; virtual; abstract;

	protected
		// IXmlNode
		function Get_NameTable: IXmlNameTable;
		function Get_NodeName: TXmlString;

		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 CloneNode(aDeep: Boolean): IXmlNode;

		procedure LoadBinXml(aReader: TBinXmlReader);
		procedure SaveBinXml(aWriter: TBinXmlWriter);

		function Get_DataType: Integer; virtual;
		function Get_TypedValue: Variant; virtual;
		procedure Set_TypedValue(const aValue: Variant); virtual;

		function Get_XML: TXmlString; virtual; abstract;

		function Get_OwnerDocument: IXmlDocument; virtual;
		function Get_ParentNode: 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 AppendProcessingInstruction(aTargetID: Integer;
			const aData: TXmlString): IXmlProcessingInstruction; overload;
		function AppendProcessingInstruction(const aTarget: TXmlString;
			const aData: TXmlString): 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 NeedChild(aNameID: Integer): IXmlNode; overload;
		function NeedChild(const aName: TXmlString): IXmlNode; overload;
		function EnsureChild(aNameID: Integer): IXmlNode; overload;
		function EnsureChild(const aName: TXmlString): IXmlNode; overload;

		procedure RemoveAllChilds;

		function SelectNodes(const anExpression: TXmlString): IXmlNodeList;
		function SelectSingleNode(const anExpression: TXmlString): IXmlNode;
		function FindElement(const anElementName, anAttrName: String; const anAttrValue: Variant): IXmlElement;

		function Get_AttrCount: Integer;
		function Get_AttrNameID(anIndex: Integer): Integer;
		function Get_AttrName(anIndex: Integer): TXmlString;
		procedure RemoveAttr(const aName: TXmlString); overload;
		procedure RemoveAttr(aNameID: Integer); overload;
		procedure RemoveAllAttrs;

		function AttrExists(aNameID: Integer): Boolean; overload;
		function AttrExists(const aName: TXmlString): Boolean; overload;

		function GetAttrType(aNameID: Integer): Integer; overload;
		function GetAttrType(const aName: TXmlString): Integer; overload;

		function GetVarAttr(aNameID: Integer; const aDefault: Variant): Variant; overload;
		function GetVarAttr(const aName: TXmlString; const aDefault: Variant): Variant; overload;
		procedure SetVarAttr(aNameID: Integer; const aValue: Variant); overload;
		procedure SetVarAttr(const aName: TXmlString; aValue: Variant); overload;

		function NeedAttr(aNameID: Integer): TXmlString; overload;
		function NeedAttr(const aName: TXmlString): TXmlString; 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 GetBoolAttr(aNameID: Integer; aDefault: Boolean = False): Boolean; overload;
		function GetBoolAttr(const aName: TXmlString; aDefault: Boolean = False): Boolean; overload;
		procedure SetBoolAttr(aNameID: Integer; aValue: Boolean = False); overload;
		procedure SetBoolAttr(const aName: TXmlString; aValue: Boolean); overload;

		function GetIntAttr(aNameID: Integer; aDefault: Integer = 0): Integer; overload;
		function GetIntAttr(const aName: TXmlString; aDefault: Integer = 0): Integer; overload;
		procedure SetIntAttr(aNameID: Integer; aValue: Integer); overload;
		procedure SetIntAttr(const aName: TXmlString; aValue: Integer); overload;

		function GetDateTimeAttr(aNameID: Integer; aDefault: TDateTime = 0): TDateTime; overload;
		function GetDateTimeAttr(const aName: TXmlString; aDefault: TDateTime = 0): TDateTime; overload;
		procedure SetDateTimeAttr(aNameID: Integer; aValue: TDateTime); overload;
		procedure SetDateTimeAttr(const aName: TXmlString; aValue: TDateTime); overload;

		function GetFloatAttr(aNameID: Integer; aDefault: Double = 0): Double; overload;
		function GetFloatAttr(const aName: TXmlString; aDefault: Double = 0): Double; overload;
		procedure SetFloatAttr(aNameID: Integer; aValue: Double); overload;
		procedure SetFloatAttr(const aName: TXmlString; aValue: Double); overload;

		function GetHexAttr(const aName: TXmlString; 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(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(aNameID: Integer;
			const aValues: array of TXmlString; aDefault: Integer = 0): Integer; overload;
		function NeedEnumAttr(const aName: TXmlString;
			const aValues: array of TXmlString): Integer; overload;
		function NeedEnumAttr(aNameID: Integer;
			const aValues: array of TXmlString): Integer; overload;


		function Get_Values(const aName: String): Variant;
		procedure Set_Values(const aName: String; const aValue: Variant);

		function AsElement: IXmlElement; virtual;
		function AsText: IXmlText; virtual;
		function AsCDATASection: IXmlCDATASection; virtual;
		function AsComment: IXmlComment; virtual;
		function AsProcessingInstruction: IXmlProcessingInstruction; virtual; 

	public
		constructor Create(aNames: TXmlNameTable);
		destructor Destroy; override;
	end;

	TXmlElement = class(TXmlNode, IXmlElement)
	private
		FNameID: Integer;
		FData: Variant;
		procedure RemoveTextNodes;
		procedure SetNodeNameID(aValue: Integer); override;
		function DoCloneNode(aDeep: Boolean): IXmlNode; override;
	protected
		function GetChilds: TXmlNodeList; override;

		function Get_NodeNameID: Integer; override;
		function Get_NodeType: Integer; override;
		function Get_Text: TXmlString; override;
		procedure Set_Text(const aValue: TXmlString); override;
		function Get_DataType: Integer; override;
		function Get_TypedValue: Variant; override;
		procedure Set_TypedValue(const aValue: Variant); override;
		function Get_XML: TXmlString; override;
		function AsElement: IXmlElement; override;
		function Get_ChildNodes: IXmlNodeList; override;

		// IXmlElement
		procedure ReplaceTextByCDATASection(const aText: TXmlString);
		procedure ReplaceTextByBynaryData(const aData; aSize: Integer;
			aMaxLineLength: Integer);
		function GetTextAsBynaryData: TXmlString;
	public
		constructor Create(aNames: TXmlNameTable; aNameID: Integer);
	end;

	TXmlCharacterData = class(TXmlNode, IXmlCharacterData)
	private
		FData: TXmlString;
	protected
		function Get_Text: TXmlString; override;
		procedure Set_Text(const aValue: TXmlString); override;
	public
		constructor Create(aNames: TXmlNameTable; const aData: TXmlString);
	end;

	TXmlText = class(TXmlNode, IXmlText)
	private
		FData: Variant;
		function DoCloneNode(aDeep: Boolean): IXmlNode; override;
	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_DataType: Integer; override;
		function Get_TypedValue: Variant; override;
		procedure Set_TypedValue(const aValue: Variant); override;
		function Get_XML: TXmlString; override;
		function AsText: IXmlText; override;
	public
		constructor Create(aNames: TXmlNameTable; const aData: Variant);
	end;

	TXmlCDATASection = class(TXmlCharacterData, IXmlCDATASection)
	protected
		function Get_NodeNameID: Integer; override;
		function Get_NodeType: Integer; override;
		function Get_XML: TXmlString; override;
		function AsCDATASection: IXmlCDATASection; override;
		function DoCloneNode(aDeep: Boolean): IXmlNode; override;
	public
	end;

	TXmlComment = class(TXmlCharacterData, IXmlComment)
	protected
		function Get_NodeNameID: Integer; override;
		function Get_NodeType: Integer; override;
		function Get_XML: TXmlString; override;
		function AsComment: IXmlComment; override;
		function DoCloneNode(aDeep: Boolean): IXmlNode; override;
	public
	end;

	TXmlProcessingInstruction = class(TXmlNode, IXmlProcessingInstruction)
	private
		FTargetID: Integer;
		FData: String;
		procedure SetNodeNameID(aValue: Integer); override;
		function DoCloneNode(aDeep: Boolean): IXmlNode; override;
	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_XML: TXmlString; override;
		function AsProcessingInstruction: IXmlProcessingInstruction; override;

	public
		constructor Create(aNames: TXmlNameTable; aTargetID: Integer;
			const aData: TXmlString);
	end;

	TXmlDocument = class(TXmlNode, IXmlDocument)
	private
		FPreserveWhiteSpace: Boolean;

		function DoCloneNode(aDeep: Boolean): IXmlNode; override;
	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_XML: TXmlString; override;
		function Get_PreserveWhiteSpace: Boolean;
		procedure Set_PreserveWhiteSpace(aValue: Boolean);

		function NewDocument(const aVersion, anEncoding: TXmlString;
			aRootElementNameID: Integer): IXmlElement; overload;
		function NewDocument(const aVersion, anEncoding,
			aRootElementName: TXmlString): 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 Get_DocumentElement: IXmlElement;
		function CreateProcessingInstruction(const aTarget,
			aData: TXmlString): IXmlProcessingInstruction; overload;
		function CreateProcessingInstruction(aTargetID: Integer;
			const aData: TXmlString): IXmlProcessingInstruction; overload;
		procedure LoadXML(const aXML: TXmlString);

		procedure Load(aStream: TStream); overload;
		procedure Load(const aFileName: TXmlString); overload;

		procedure LoadResource(aType, aName: PChar);
		 
		procedure Save(aStream: TStream); overload;
		procedure Save(const aFileName: TXmlString); overload;

		procedure SaveBinary(aStream: TStream; anOptions: LongWord); overload;
		procedure SaveBinary(const aFileName: TXmlString; anOptions: LongWord); overload;

		function Get_BinaryXML: String;
		procedure LoadBinaryXML(const aXML: String);
	public
		constructor Create(aNames: TXmlNameTable);
	end;

{ TXmlNodeList }

procedure TXmlNodeList.Clear;
var
	i: Integer;
	aNode: TXmlNode;
begin
	for i := 0 to FCount - 1 do begin
		aNode := FItems[i];
		if Assigned(FOwnerNode) then
			aNode.FParentNode := nil;
		aNode._Release;
	end;
	FCount := 0;
end;

procedure TXmlNodeList.Delete(anIndex: Integer);
var
	aNode: TXmlNode;
begin
	aNode := FItems[anIndex];
	Dec(FCount);
	if anIndex < FCount then
		Move(FItems[anIndex + 1], FItems[anIndex],
			(FCount - anIndex)*SizeOf(TXmlNode));
	if Assigned(aNode) then begin
		if Assigned(FOwnerNode) then
			aNode.FParentNode := nil;
		aNode._Release;
	end;
end;

constructor TXmlNodeList.Create(anOwnerNode: TXmlNode);
begin
	inherited Create;
	FOwnerNode := anOwnerNode;
end;

destructor TXmlNodeList.Destroy;
begin
	Clear;