simplexml.pas

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

	inherited;
end;

function TXmlNodeList.Get_Item(anIndex: Integer): IXmlNode;
begin
	if (anIndex < 0) or (anIndex >= FCount) then
		raise Exception.Create(SSimpleXmlError1);
	Result := FItems[anIndex]
end;

function TXmlNodeList.Get_Count: Integer;
begin
	Result := FCount
end;

function TXmlNodeList.IndexOf(aNode: TXmlNode): Integer;
var
	i: Integer;
begin
	for i := 0 to FCount - 1 do
		if FItems[i] = aNode then begin
			Result := i;
			Exit
		end;
	Result := -1;
end;

procedure TXmlNodeList.Grow;
var
	aDelta: Integer;
begin
	if Length(FItems) > 64 then
		aDelta := Length(FItems) div 4
	else
		if Length(FItems) > 8 then
			aDelta := 16
		else
			aDelta := 4;
	SetLength(FItems, Length(FItems) + aDelta);
end;

procedure TXmlNodeList.Insert(aNode: TXmlNode; anIndex: Integer);
begin
	if anIndex = -1 then
		anIndex := FCount;
	if FCount = Length(FItems) then
		Grow;
	if anIndex < FCount then
		Move(FItems[anIndex], FItems[anIndex + 1],
			(FCount - anIndex)*SizeOf(TXmlNode));
	FItems[anIndex] := aNode;
	Inc(FCount);
	if aNode <> nil then begin
		aNode._AddRef;
		if Assigned(FOwnerNode) then begin
			aNode.FParentNode := FOwnerNode;
			aNode.SetNameTable(FOwnerNode.FNames, nil);
		end;
	end;
end;

function TXmlNodeList.Remove(aNode: TXmlNode): Integer;
begin
	Result := IndexOf(aNode);
	if Result <> -1 then
		Delete(Result);
end;

procedure TXmlNodeList.Replace(anIndex: Integer; aNode: TXmlNode);
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;
end;

function TXmlNodeList.Get_XML: TXmlString;
var
	i: Integer;
begin
	Result := '';
	for i := 0 to FCount - 1 do
		Result := Result + FItems[i].Get_XML;
end;

procedure TXmlNodeList.ParseXML(aXML: TXmlSource; aNames: TXmlNameTable; aPreserveWhiteSpace: Boolean);
	procedure ParseText;
	var
		aText: String;
	begin
		aXml.NewToken;
		while not aXML.EOF and (aXML.CurChar <> '<') do
			if aXML.CurChar = '&' then
				aXml.AppendTokenChar(aXml.ExpectXmlEntity)
			else begin
				aXml.AppendTokenChar(aXML.CurChar);
				aXML.Next;
			end;
		aText := aXml.AcceptToken;
		if aPreserveWhiteSpace or (Trim(aText) <> '') then
			Insert(TXmlText.Create(aNames, aText), -1);
	end;

	// CurChar - '?'
	procedure ParseProcessingInstruction;
	var
		aTarget: TXmlString;
		aNode: TXmlProcessingInstruction;
	begin
		aXML.Next;
		aTarget := aXML.ExpectXmlName;
		aNode := TXmlProcessingInstruction.Create(aNames, aNames.GetID(aTarget), '');
		Insert(aNode, -1);
		if aNode.FTargetID = aNames.FXmlID then begin
			aXml.ParseAttrs(aNode);
			aXml.ExpectText('?>');
		end
		else
			aNode.FData := aXml.ParseTo('?>');
	end;

	procedure ParseComment;
	begin
		aXml.ExpectText('--');
		Insert(TXmlComment.Create(aNames, aXml.ParseTo('-->')), -1);
	end;

	procedure ParseCDATA;
	begin
		aXml.ExpectText('[CDATA[');
		Insert(TXmlCDATASection.Create(aNames, aXml.ParseTo(']]>')), -1);
	end;


	procedure ParseDOCTYPE;
	begin
		aXml.ExpectText('DOCTYPE');
		aXml.ParseTo('>');
	end;

	procedure ParseElement;
	var
		aNameID: Integer;
		aNode: TXmlElement;
	begin
		aNameID := aNames.GetID(aXml.ExpectXmlName);
		if aXml.EOF then
			raise Exception.Create(SSimpleXMLError2);
		if not ((aXml.CurChar <= ' ') or (aXml.CurChar = '/') or (aXml.CurChar = '>')) then
			raise Exception.Create(SSimpleXMLError3);
		aNode := TXmlElement.Create(aNames, aNameID);
		Insert(aNode, -1);
		aXml.ParseAttrs(aNode);
		if aXml.CurChar = '/' then
			aXml.ExpectText('/>')
		else begin
			aXml.ExpectChar('>');
			aNode.GetChilds.ParseXML(aXml, aNames, aPreserveWhiteSpace);
			aXml.ExpectChar('/');
			aXml.ExpectText(PXmlChar(aNames.GetName(aNameID)));
			aXml.SkipBlanks;
			aXml.ExpectChar('>');
		end;
	end;

begin
	while not aXML.EOF do begin
		ParseText;
		if aXML.CurChar = '<' then
			if aXML.Next then
				if aXML.CurChar = '/' then  
					Exit
				else if aXML.CurChar = '?' then // 桧耱痼牿?
					ParseProcessingInstruction
				else if aXML.CurChar = '!' then begin
					if aXML.Next then
						if aXML.CurChar = '-' then
							ParseComment
						else if aXML.CurChar = '[' then
							ParseCDATA
						else
							ParseDOCTYPE
				end
				else
					ParseElement
	end;
end;

procedure TXmlNodeList.LoadBinXml(aReader: TBinXmlReader;
	aCount: Integer; aNames: TXmlNameTable);
var
	i: Integer;
	aNodeType: Byte;
	aNode: TXmlNode;
	aNameID: LongInt;
begin
	Clear;
	SetLength(FItems, aCount);
	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);
					Insert(aNode, -1);
					aReader.ReadVariant(TVarData(TXmlElement(aNode).FData));
					aNode.LoadBinXml(aReader);
				end;
			NODE_TEXT:
				begin
					aNode := TXmlText.Create(aNames, Unassigned);
					Insert(aNode, -1);
					aReader.ReadVariant(TVarData(TXmlText(aNode).FData));
				end;
			NODE_CDATA_SECTION:
				Insert(TXmlCDATASection.Create(aNames, aReader.ReadXmlString), -1);
			NODE_PROCESSING_INSTRUCTION:
				begin
					aNameID := aReader.ReadLongint;
					aNode := TXmlProcessingInstruction.Create(aNames, aNameID,
						aReader.ReadXmlString);
					Insert(aNode, -1);
					aNode.LoadBinXml(aReader);
				end;
			NODE_COMMENT:
				Insert(TXmlComment.Create(aNames, aReader.ReadXmlString), -1);
			else
				raise Exception.Create(SSimpleXMLError4);
		end
	end;
end;

procedure TXmlNodeList.SaveBinXml(aWriter: TBinXmlWriter);
const
	EmptyVar: TVarData = (VType:varEmpty);
var
	aCount: LongInt;
	i: Integer;
	aNodeType: Byte;
	aNode: TXmlNode;
begin
	aCount := FCount;
	for i := 0 to aCount - 1 do begin
		aNode := FItems[i];
		aNodeType := aNode.Get_NodeType;
		aWriter.Write(aNodeType, sizeof(aNodeType));
		case aNodeType of
			NODE_ELEMENT:
				with TXmlElement(aNode) do begin
					aWriter.WriteLongint(FNameID);
					if Assigned(FChilds) and (FChilds.FCount > 0) or VarIsEmpty(FData) then
						aWriter.WriteVariant(EmptyVar)
					else
						aWriter.WriteVariant(TVarData(FData));
					SaveBinXml(aWriter);
				end;
			NODE_TEXT:
				aWriter.WriteVariant(TVarData(TXmlText(aNode).FData));
			NODE_CDATA_SECTION:
				aWriter.WriteXmlString(TXmlCDATASection(aNode).FData);
			NODE_PROCESSING_INSTRUCTION:
				begin
					aWriter.WriteLongint(TXmlProcessingInstruction(aNode).FTargetID);
					aWriter.WriteXmlString(TXmlProcessingInstruction(aNode).FData);
					aNode.SaveBinXml(aWriter);
				end;
			NODE_COMMENT:
				aWriter.WriteXmlString(TXmlComment(aNode).FData);
			else
				raise Exception.Create(SSimpleXmlError5);
		end
	end;
end;

{ TXmlNode }

constructor TXmlNode.Create(aNames: TXmlNameTable);
begin
	inherited Create;
	FNames := aNames;
	FNames._AddRef;
end;

destructor TXmlNode.Destroy;
begin
	if Assigned(FChilds) then
		FChilds._Release;
	FNames._Release;
	inherited;
end;

function TXmlNode.GetChilds: TXmlNodeList;
begin
	if not Assigned(FChilds) then begin
		FChilds := TXmlNodeList.Create(Self);
		FChilds._AddRef;
	end;
	Result := FChilds;
end;

procedure TXmlNode.AppendChild(const aChild: IXmlNode);
begin
	GetChilds.Insert(aChild.GetObject as TXmlNode, -1);
end;

function TXmlNode.Get_AttrCount: Integer;
begin
	Result := FAttrCount;
end;

function TXmlNode.Get_AttrName(anIndex: Integer): TXmlString;
begin
	Result := FNames.GetName(FAttrs[anIndex].NameID);
end;

function TXmlNode.Get_AttrNameID(anIndex: Integer): Integer;
begin
	Result := FAttrs[anIndex].NameID;
end;

function TXmlNode.Get_ChildNodes: IXmlNodeList;
begin
	Result := GetChilds
end;

function TXmlNode.Get_NameTable: IXmlNameTable;
begin
	Result := FNames
end;

function TXmlNode.GetAttr(const aName, aDefault: TXmlString): TXmlString;
begin
	Result := GetAttr(FNames.GetID(aName), aDefault)
end;

function TXmlNode.GetAttr(aNameID: Integer;
	const aDefault: TXmlString): TXmlString;
var
	aData: PXmlAttrData;
begin
	aData := FindAttrData(aNameID);
	if Assigned(aData) then
		Result := aData.Value
	else
		Result := aDefault
end;

function TXmlNode.GetBoolAttr(aNameID: Integer;
  aDefault: Boolean): Boolean;
var
	aData: PXmlAttrData;
begin
	aData := FindAttrData(aNameID);
	if Assigned(aData) then
		Result := aData.Value
	else
		Result := aDefault
end;

function TXmlNode.GetBoolAttr(const aName: TXmlString;
  aDefault: Boolean): Boolean;
begin
	Result := GetBoolAttr(FNames.GetID(aName), aDefault)
end;

function TXmlNode.FindFirstChild(aNameID: Integer): TXmlNode;
var
	i: Integer;
begin
	if Assigned(FChilds) then
		for i := 0 to FChilds.FCount - 1 do begin
			Result := FChilds.FItems[i];
			if Result.Get_NodeNameID = aNameID then
				Exit
		end;
	Result := nil
end;

function TXmlNode.GetChildText(aNameID: Integer;
	const aDefault: TXmlString): TXmlString;
var
	aChild: TXmlNode;
begin
	aChild := FindFirstChild(aNameID);
	if Assigned(aChild) then
		Result := aChild.Get_Text
	else
		Result := aDefault
end;

function TXmlNode.GetChildText(const aName: TXmlString;
  const aDefault: TXmlString): TXmlString;
begin
	Result := GetChildText(FNames.GetID(aName), aDefault);
end;

function TXmlNode.GetEnumAttr(const aName: TXmlString;
	const aValues: array of TXmlString; aDefault: Integer): Integer;
begin
	Result := GetEnumAttr(FNames.GetID(aName), aValues, aDefault);
end;

function EnumAttrValue(aNode: TXmlNode; anAttrData: PXmlAttrData;
	const aValues: array of TXmlString): Integer;
var
	anAttrValue: TXmlString;
	s: String;
	i: Integer;
begin
	anAttrValue := anAttrData.Value;
	for Result := 0 to Length(aValues) - 1 do
		if AnsiCompareText(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];
	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;
var
	anAttrData: PXmlAttrData;
begin
	anAttrData := FindAttrData(aNameID);
	if Assigned(anAttrData) then
		Result := EnumAttrValue(Self, anAttrData, aValues)
	else
		Result := aDefault;
end;

function TXmlNode.NeedEnumAttr(const aName: TXmlString;
	const aValues: array of TXmlString): Integer;