Парсер подавляющего большинства нотаций XML
01.01.2007
Сайт: http://delphibase.endimus.com
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Парсер подавляющего большинства нотаций XML.
Для задачи десериализации мне потребовался парсер.
Основное преимущество - никак не связан с операционной системой
(в отличие от TXMLDocument), ну и разумеется - простота :)
Зависимости: SysUtils, StrUtils
Автор: Delirium, VideoDVD@hotmail.com, ICQ:118395746, Москва
Copyright: Delirium (Master BRAIN) 2003
Дата: 16 сентября 2003 г.
***************************************************** }
unit BNFXMLParser;
interface
uses SysUtils, StrUtils;
type
PXMLNode = ^TXMLNode;
TXMLValues = (TextNode, XMLNode);
TXMLNode = record
Name: string;
Attributes: array of record
Name: string;
Value: string;
end;
SubNodes: array of record
RecType: TXMLValues;
case TXMLValues of
TextNode: (Text: PString);
XMLNode: (XML: PXMLNode);
end;
Parent: PXMLNode;
end;
function BNFXMLTree(var Value: string): PXMLNode;
implementation
function fnTEG(var Node: PXMLNode; var Value: string): boolean; forward;
function fnVAL(var Node: PXMLNode; var Value: string): boolean; forward;
function fnATT(var Node: PXMLNode; var Value: string): boolean; forward;
function fnXML(var Node: PXMLNode; var Value: string): boolean;
var
i: integer;
begin
if (Pos('<', Value) > 0)
and (Pos('>', Value) > Pos('<', Value))
and (Pos('<', Value) <> Pos('</', Value)) then
begin
// Оганизую узел
if Node = nil then
begin
New(Node);
Node.Parent := nil;
end
else
begin
i := length(Node.SubNodes);
Setlength(Node.SubNodes, i + 1);
New(Node.SubNodes[i].XML);
Node.SubNodes[i].RecType := XMLNode;
Node.SubNodes[i].XML.Parent := Node;
Node := Node.SubNodes[i].XML;
end;
Result := fnTEG(Node, Value);
end // '<'
else
Result := True;
end;
function fnTEG(var Node: PXMLNode; var Value: string): boolean;
var
i, i1, i2, i3: integer;
S: string;
begin
Result := False;
i1 := Pos('<', Value);
if i1 > 0 then
begin
i2 := PosEx('/>', Value, i1);
i3 := PosEx('>', Value, i1);
if (i2 > 0) and (i2 < i3) then
begin // <abc/>
// Value
S := Copy(Value, i1 + 1, (i2 - i1) - 1);
Delete(Value, i1, (i2 - i1) + 2);
// TEXT, этот текст пренадлежит предку
if Node.Parent <> nil then
begin // Добавляюсь к предку
i := length(Node.Parent.SubNodes);
Setlength(Node.Parent.SubNodes, i + 1);
New(Node.Parent.SubNodes[i].Text);
Node.Parent.SubNodes[i].RecType := TextNode;
Node.Parent.SubNodes[i].Text^ := Copy(Value, 1, Pos('<', Value) - 1);
end;
Delete(Value, 1, Pos('<', Value) - 1);
//
if fnVAL(Node, S) then
begin // Вложенных тегов не бывает
Node := Node.Parent;
Result := fnXML(Node, Value);
end;
end
else
begin // <abc>...</abc>
// Value
S := Copy(Value, i1 + 1, (i3 - i1) - 1);
Delete(Value, i1, (i3 - i1) + 1);
// TEXT
i := length(Node.SubNodes);
Setlength(Node.SubNodes, i + 1);
New(Node.SubNodes[i].Text);
Node.SubNodes[i].RecType := TextNode;
Node.SubNodes[i].Text^ := Copy(Value, 1, Pos('<', Value) - 1);
Delete(Value, 1, Pos('<', Value) - 1);
//
if fnVAL(Node, S) then
begin // Val
// Проверяю закрытие тега, удаляю хвост и передаю управление предку
if Pos('</' + AnsiLowerCase(Node.Name) + '>', AnsiLowerCase(Value)) = 1
then
begin
Delete(Value, 1, Length('</' + Node.Name + '>'));
// TEXT принадлежащий предку
if Node.Parent <> nil then
begin // Добавляюсь к предку
i := length(Node.Parent.SubNodes);
Setlength(Node.Parent.SubNodes, i + 1);
New(Node.Parent.SubNodes[i].Text);
Node.Parent.SubNodes[i].RecType := TextNode;
Node.Parent.SubNodes[i].Text^ := Copy(Value, 1, Pos('<', Value) -
1);
end;
Delete(Value, 1, Pos('<', Value) - 1);
Node := Node.Parent;
Result := fnXML(Node, Value);
end
else
begin
// Обрабатываю вложенные теги, на выходе мой узел
if fnXML(Node, Value) then
begin
// закрываю его
if Pos('</' + AnsiLowerCase(Node.Name) + '>', AnsiLowerCase(Value))
= 1 then
begin
Delete(Value, 1, Length('</' + Node.Name + '>'));
// TEXT принадлежащий предку
if Node.Parent <> nil then
begin // Добавляюсь к предку
i := length(Node.Parent.SubNodes);
Setlength(Node.Parent.SubNodes, i + 1);
New(Node.Parent.SubNodes[i].Text);
Node.Parent.SubNodes[i].RecType := TextNode;
Node.Parent.SubNodes[i].Text^ := Copy(Value, 1, Pos('<', Value)
- 1);
end;
Delete(Value, 1, Pos('<', Value) - 1);
end;
// Остальной XML - предку
if Node.Parent <> nil then
Node := Node.Parent;
Result := fnXML(Node, Value);
end;
end;
end; // Val
end; // <abc>...</abc>
end; // i1
end;
function fnVAL(var Node: PXMLNode; var Value: string): boolean;
begin
Value := AnsiReplaceStr(Value, '''', '"');
if (Pos(' ', Value) > 0)
and (Pos('="', Value) > Pos(' ', Value)) then
begin
Node.Name := Trim(Copy(Value, 1, Pos(' ', Value) - 1)); // Название тега Name
Delete(Value, 1, Pos(' ', Value));
Result := fnATT(Node, Value);
end // ' ' и ('="'
else
begin
// Название тега Name
Value := Trim(Value);
if Pos(' ', Value) > 0 then
Node.Name := Copy(Value, 1, Pos(' ', Value) - 1)
else
Node.Name := Value;
Value := '';
Result := True;
end;
end;
function fnATT(var Node: PXMLNode; var Value: string): boolean;
begin
Result := True;
Value := Trim(Value);
if Pos('="', Value) > 0 then
begin
Result := False;
SetLength(Node.Attributes, Length(Node.Attributes) + 1);
// Название атрибута
Node.Attributes[Length(Node.Attributes) - 1].Name := Trim(Copy(Value, 1,
Pos('="', Value) - 1));
Delete(Value, 1, Pos('="', Value) + 1);
if Pos('"', Value) > 0 then
begin
// Значение атрибута
Node.Attributes[Length(Node.Attributes) - 1].Value := Copy(Value, 1,
Pos('"', Value) - 1);
Delete(Value, 1, Pos('"', Value));
if Length(Value) > 0 then
Result := fnATT(Node, Value)
else
Result := True;
end;
end;
end;
function BNFXMLTree(var Value: string): PXMLNode;
begin
Result := nil;
fnXML(Result, Value);
end;
end.
Пример использования:
procedure TForm1.Button1Click(Sender: TObject);
var
S: string;
Node: PXMLNode;
i: integer;
begin
S := '<A> aaa1 ' + #13 +
' aaa2 aaa3 ' + #13 +
' <B>bbb ' + #13 +
' <C>ccc</C> ' + #13 +
' </B> ' + #13 +
' <D>ddd ' + #13 +
' <E eee="EEE"/> ' + #13 +
' </D> ' + #13 +
'</A> ';
Node := BNFXMLTree(S);
for i := 0 to Length(Node.SubNodes) - 1 do
case Node.SubNodes[i].RecType of
TextNode: ShowMessage('Text = ' + Node.SubNodes[i].Text^);
XMLNode: ShowMessage('XML Node name = ' + Node.SubNodes[i].XML.Name);
end;
end;
Взято из https://forum.sources.ru