simplexml.pas

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

begin
	Result := NeedEnumAttr(FNames.GetID(aName), aValues)
end;

function TXmlNode.NeedEnumAttr(aNameID: Integer;
	const aValues: array of TXmlString): Integer;
var
	anAttrData: PXmlAttrData;
begin
	anAttrData := FindAttrData(aNameID);
	if Assigned(anAttrData) then
		Result := EnumAttrValue(Self, anAttrData, aValues)
	else
		raise Exception.CreateFmt(SSimpleXMLError7, [FNames.GetName(aNameID)]);
end;

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

function TXmlNode.GetFloatAttr(aNameID: Integer;
	aDefault: Double): Double;
var
	aData: PXmlAttrData;
begin
	aData := FindAttrData(aNameID);
	if Assigned(aData) then
		if VarIsNumeric(aData.Value) then
			Result := aData.Value
		else
			Result := XSTRToFloat(aData.Value)
	else
		Result := aDefault
end;

function TXmlNode.GetHexAttr(aNameID, aDefault: Integer): Integer;
var
	anAttr: PXmlAttrData;
begin
	anAttr := FindAttrData(aNameID);
	if Assigned(anAttr) then
		Result := StrToInt('$' + anAttr.Value)
	else
		Result := aDefault;
end;

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

function TXmlNode.GetIntAttr(aNameID, aDefault: Integer): Integer;
var
	anAttr: PXmlAttrData;
begin
	anAttr := FindAttrData(aNameID);
	if Assigned(anAttr) then
		Result := anAttr.Value
	else
		Result := aDefault;
end;

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

function TXmlNode.NeedAttr(aNameID: Integer): TXmlString;
var
	anAttr: PXmlAttrData;
begin
	anAttr := FindAttrData(aNameID);
	if not Assigned(anAttr) then
		raise Exception.CreateFmt(SSimpleXmlError8, [FNames.GetName(aNameID)]);
	Result := anAttr.Value
end;

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

function TXmlNode.GetVarAttr(aNameID: Integer;
  const aDefault: Variant): Variant;
var
	anAttr: PXmlAttrData;
begin
	anAttr := FindAttrData(aNameID);
	if Assigned(anAttr) then
		Result := anAttr.Value
	else
		Result := aDefault;
end;

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

function TXmlNode.Get_NodeName: TXmlString;
begin
	Result := FNames.GetName(Get_NodeNameID);
end;

function TXmlNode.GetOwnerDocument: TXmlDocument;
var
	aResult: TXmlNode;
begin
	aResult := Self;
	repeat
		if aResult is TXmlDocument then
			break
		else
			aResult := aResult.FParentNode;
	until not Assigned(aResult);
	Result := TXmlDocument(aResult)
end;

function TXmlNode.Get_OwnerDocument: IXmlDocument;
var
	aDoc: TXmlDocument;
begin
	aDoc := GetOwnerDocument;
	if Assigned(aDoc) then
		Result := aDoc
	else
		Result := nil;
end;

function TXmlNode.Get_ParentNode: IXmlNode;
begin
	Result := FParentNode
end;

function TXmlNode.Get_TypedValue: Variant;
begin
	Result := Get_Text
end;

procedure TXmlNode.InsertBefore(const aChild, aBefore: IXmlNode);
var
	i: Integer;
	aChilds: TXmlNodeList;
begin
	aChilds := GetChilds;
	if Assigned(aBefore) then
		i := aChilds.IndexOf(aBefore.GetObject as TXmlNode)
	else
		i := aChilds.FCount;
	GetChilds.Insert(aChild.GetObject as TXmlNode, i)
end;

procedure TXmlNode.RemoveAllAttrs;
begin
	FAttrCount := 0; 
end;

procedure TXmlNode.RemoveAllChilds;
begin
	if Assigned(FChilds) then
		FChilds.Clear
end;

procedure TXmlNode.RemoveAttr(const aName: TXmlString);
begin
	RemoveAttr(FNames.GetID(aName));
end;

procedure TXmlNode.RemoveAttr(aNameID: Integer);
var
	a1, a2: PXmlAttrData;
	i: Integer;
begin
	a1 := @FAttrs[0];
	i := 0;
	while (i < FAttrCount) and (a1.NameID <> aNameID) do begin
		Inc(a1);
		Inc(i)
	end;
	if i < FAttrCount then begin
		a2 := a1;
		Inc(a2);
		while i < FAttrCount - 1 do begin
			a1^ := a2^;
			Inc(a1);
			Inc(a2);
			Inc(i)
		end;
		VarClear(a1.Value);
		Dec(FAttrCount);
	end;
end;

procedure TXmlNode.RemoveChild(const aChild: IXmlNode);
begin
	GetChilds.Remove(aChild.GetObject as TXmlNode)
end;

procedure TXmlNode.ReplaceChild(const aNewChild, anOldChild: IXmlNode);
var
	i: Integer;
	aChilds: TXmlNodeList;
begin
	aChilds := GetChilds;
	i := aChilds.IndexOf(anOldChild.GetObject as TXmlNode);
	if i <> -1 then
		aChilds.Replace(i, aNewChild.GetObject as TXmlNode)
end;

function NameCanBeginWith(aChar: TXmlChar): Boolean;
begin
	{$IFDEF XML_WIDE_CHARS}
	Result := (aChar = '_') or IsCharAlphaW(aChar)
	{$ELSE}
	Result := (aChar = '_') or IsCharAlpha(aChar)
	{$ENDIF}
end;

function NameCanContain(aChar: TXmlChar): 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}
end;

function IsName(const s: TXmlString): Boolean;
var
	i: Integer;
begin
	if s = '' then
		Result := False
	else if not NameCanBeginWith(s[1]) then
		Result := False
	else begin
		for i := 2 to Length(s) do
			if not NameCanContain(s[i]) then begin
				Result := False;
				Exit
			end;
		Result := True;
	end;
end;

const
	ntComment = -2;
	ntNode = -3;
	ntProcessingInstruction = -4;
	ntText = -5;
		
type
	TAxis = (axAncestor, axAncestorOrSelf, axAttribute, axChild,
		axDescendant, axDescendantOrSelf, axFollowing, axFollowingSibling,
		axParent, axPreceding, axPrecedingSibling, axSelf);

	TPredicate = class
		function Check(aNode: TXmlNode): Boolean; virtual; abstract;
	end;

	TLocationStep = class
		Next: TLocationStep;
		Axis: TAxis;
		NodeTest: Integer;
		Predicates: TList;
	end;
	


function TXmlNode.SelectNodes(
	const anExpression: TXmlString): IXmlNodeList;
var
	aNodes: TXmlNodeList;
	aChilds: TXmlNodeList;
	aChild: TXmlNode;
	aNameID: Integer;
	i: Integer;
{
	aPath: TXmlPath;
}
begin
	if IsName(anExpression) then begin
		aNodes := TXmlNodeList.Create(nil);
		Result := aNodes;
		aChilds := GetChilds;
		aNameID := FNames.GetID(anExpression);
		for i := 0 to aChilds.FCount - 1 do begin
			aChild := aChilds.FItems[i];
			if (aChild.Get_NodeType = NODE_ELEMENT) and (aChild.Get_NodeNameID = aNameID) then
				aNodes.Insert(aChild, aNodes.FCount);
		end;
	end
	else begin
		raise
			Exception.Create(SSimpleXmlError9);
{
		aPath := TXmlPath.Create;
		try
			aPath.Init(anExpression);
			Result := aPath.SelectNodes(Self);
		finally
			aPath.Free
		end
}
	end;
end;

function TXmlNode.SelectSingleNode(
	const anExpression: TXmlString): IXmlNode;
var
	aChilds: TXmlNodeList;
	aChild: TXmlNode;
	aNameID: Integer;
	i: Integer;
begin
	if IsName(anExpression) then begin
		aChilds := GetChilds;
		aNameID := FNames.GetID(anExpression);
		for i := 0 to aChilds.FCount - 1 do begin
			aChild := aChilds.FItems[i];
			if (aChild.Get_NodeType = NODE_ELEMENT) and (aChild.Get_NodeNameID = aNameID) then begin
				Result := aChild;
				Exit
			end
		end;
		Result := nil;
	end
	else begin
		raise
			Exception.Create(SSimpleXmlError9)
	end
end;

function TXmlNode.FindElement(const anElementName, anAttrName: String;
	const anAttrValue: Variant): IXmlElement;
var
	aChild: TXmlNode;
	aNameID, anAttrNameID: Integer;
	i: Integer;
	pa: PXmlAttrData;
begin
	if Assigned(FChilds) then begin
		aNameID := FNames.GetID(anElementName);
		anAttrNameID := FNames.GetID(anAttrName);

		for i := 0 to FChilds.FCount - 1 do begin
			aChild := FChilds.FItems[i];
			if (aChild.Get_NodeType = NODE_ELEMENT) and (aChild.Get_NodeNameID = aNameID) then begin
				pa := aChild.FindAttrData(anAttrNameID);
				try
					if Assigned(pa) and VarSameValue(pa.Value, anAttrValue) then begin
						Result := aChild.AsElement;
						Exit
					end
				except
				end;
			end
		end;
	end;
	Result := nil;
end;

procedure TXmlNode.Set_TypedValue(const aValue: Variant);
begin
  Set_Text(aValue)
end;

procedure TXmlNode.SetAttr(const aName, aValue: TXmlString);
begin
	SetVarAttr(FNames.GetID(aName), aValue)
end;

procedure TXmlNode.SetAttr(aNameID: Integer; const aValue: TXmlString);
begin
	SetVarAttr(aNameID, aValue)
end;

procedure TXmlNode.SetBoolAttr(aNameID: Integer; aValue: Boolean);
begin
	SetVarAttr(aNameID, aValue)
end;

procedure TXmlNode.SetBoolAttr(const aName: TXmlString; aValue: Boolean);
begin
	SetVarAttr(FNames.GetID(aName), aValue)
end;

procedure TXmlNode.SetChildText(const aName: TXmlString;
	const aValue: TXmlString);
begin
	SetChildText(FNames.GetID(aName), aValue)
end;

procedure TXmlNode.SetChildText(aNameID: Integer; const aValue: TXmlString);
var
	aChild: TXmlNode;
begin
	aChild := FindFirstChild(aNameID);
	if not Assigned(aChild) then begin
		aChild := TXmlElement.Create(FNames, aNameID);
		with GetChilds do
			Insert(aChild, FCount);
	end;
	aChild.Set_Text(aValue)
end;

procedure TXmlNode.SetFloatAttr(aNameID: Integer; aValue: Double);
begin
	SetVarAttr(aNameID, aValue)
end;

procedure TXmlNode.SetFloatAttr(const aName: TXmlString; aValue: Double);
begin
	SetVarAttr(FNames.GetID(aName), aValue);
end;

procedure TXmlNode.SetHexAttr(const aName: TXmlString; aValue,
  aDigits: Integer);
begin
	SetVarAttr(FNames.GetID(aName), IntToHex(aValue, aDigits))
end;

procedure TXmlNode.SetHexAttr(aNameID, aValue, aDigits: Integer);
begin
	SetVarAttr(aNameID, IntToHex(aValue, aDigits))
end;

procedure TXmlNode.SetIntAttr(aNameID, aValue: Integer);
begin
	SetVarAttr(aNameID, aValue)
end;

procedure TXmlNode.SetIntAttr(const aName: TXmlString; aValue: Integer);
begin
	SetVarAttr(FNames.GetID(aName), aValue)
end;

procedure TXmlNode.SetVarAttr(const aName: TXmlString; aValue: Variant);
begin
  SetVarAttr(FNames.GetID(aName), aValue)
end;

procedure TXmlNode.SetVarAttr(aNam