Разбор XML



Автор: Delirium
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Разбор XML
Данный прасер не такой универсальный, как предыдущий,
за то - почти в 1000 раз эффективнее!
Зависимости: Windows, Forms, SysUtils, StrUtils
Автор:       Delirium, [email protected], ICQ:118395746, Москва
Copyright:   Delirium (Master BRAIN) 2003
Дата:        22 октября 2003 г.
***************************************************** }
unit BNFXMLParser2;
interface
uses Windows, Forms, SysUtils, StrUtils;
type
PXMLNode = ^TXMLNode;
PXMLTree = ^TXMLTree;
TXMLAttr = record
NameIndex, NameSize: integer;
TextIndex, TextSize: integer;
end;
TXMLNode = record
NameIndex, NameSize: integer;
Attributes: array of TXMLAttr;
TextIndex, TextSize: integer;
SubNodes: array of PXMLNode;
Parent: PXMLNode;
Data: PString;
end;
TXMLTree = record
Data: PString;
TextSize: integer;
NodesCount: integer;
Nodes: array of PXMLNode;
end;
function BNFXMLTree(Value: string): PXMLTree;
function GetXMLNodeName(Node: PXMLNode): string;
function GetXMLNodeText(Node: PXMLNode): string;
function GetXMLNodeAttr(AttrName: string; Node: PXMLNode): string;
implementation
function BNFXMLTree(Value: string): PXMLTree;
var
LPos, k, State, CurAttr: integer;
i: integer;
CurNode: PXMLNode;
begin
New(Result);
Result^.TextSize := Pos('<', Value) - 1;
New(Result^.Data);
Result^.Data^ := Value;
k := 0;
State := 0;
CurNode := nil;
CurAttr := -1;
for LPos := Result.TextSize + 1 to Length(Value) do
case State of
0: case Value[LPos] of
'<':
begin
i := length(Result.Nodes);
Setlength(Result.Nodes, i + 1);
New(Result.Nodes[i]);
Inc(k);
if k mod 10 = 0 then
begin
Application.ProcessMessages;
if k mod 100 = 0 then
SleepEx(1, True);
end;
CurNode := Result.Nodes[i];
CurNode^.NameIndex := 0;
CurNode^.NameSize := 0;
CurNode^.TextIndex := 0;
CurNode^.Parent := nil;
CurNode^.Data := Result^.Data;
State := 1;
end;
end;
1: case Value[LPos] of
' ': ;
'>': State := 9;
'/': State := 10;
else
begin
CurNode^.NameIndex := LPos;
CurNode^.NameSize := 1;
State := 2;
end;
end;
2: case Value[LPos] of
' ': State := 3;
'>': State := 9;
'/': State := 10;
else
Inc(CurNode^.NameSize);
end;
3: case Value[LPos] of
' ': ;
'>': State := 9;
'/': State := 10;
else
begin
i := length(CurNode^.Attributes);
Setlength(CurNode^.Attributes, i + 1);
CurNode^.Attributes[i].NameIndex := LPos;
CurNode^.Attributes[i].NameSize := 1;
CurAttr := i;
State := 4;
end;
end;
4: case Value[LPos] of
'=': State := 5;
else
Inc(CurNode^.Attributes[CurAttr].NameSize);
end;
5: case Value[LPos] of
'''': State := 6;
'"': State := 7;
end;
6: case Value[LPos] of
'''':
begin
CurNode^.Attributes[CurAttr].TextIndex := LPos;
CurNode^.Attributes[CurAttr].TextSize := 0;
State := 8;
end;
else
begin
CurNode^.Attributes[CurAttr].TextIndex := LPos;
CurNode^.Attributes[CurAttr].TextSize := 1;
State := 61;
end;
end;
7: case Value[LPos] of
'"':
begin
CurNode^.Attributes[CurAttr].TextIndex := LPos;
CurNode^.Attributes[CurAttr].TextSize := 0;
State := 8;
end;
else
begin
CurNode^.Attributes[CurAttr].TextIndex := LPos;
CurNode^.Attributes[CurAttr].TextSize := 1;
State := 71;
end;
end;
61: case Value[LPos] of
'''': State := 8;
else
Inc(CurNode^.Attributes[CurAttr].TextSize);
end;
71: case Value[LPos] of
'"': State := 8;
else
Inc(CurNode^.Attributes[CurAttr].TextSize);
end;
8: case Value[LPos] of
' ': State := 3;
'>': State := 9;
'/': State := 10;
end;
9: case Value[LPos] of
'>': ;
else
begin
CurNode^.TextIndex := LPos;
CurNode^.TextSize := 1;
State := 11;
end;
end;
10: case Value[LPos] of
'>':
begin
CurNode := CurNode^.Parent;
if CurNode = nil then
State := 0
else
State := 9;
end;
end;
11: case Value[LPos] of
'<': State := 12;
else
Inc(CurNode^.TextSize);
end;
12: case Value[LPos] of
'/': State := 10;
else
begin
i := length(CurNode^.SubNodes);
Setlength(CurNode^.SubNodes, i + 1);
New(CurNode^.SubNodes[i]);
Inc(k);
if k mod 10 = 0 then
begin
Application.ProcessMessages;
if k mod 100 = 0 then
SleepEx(1, True);
end;
CurNode^.SubNodes[i]^.Parent := CurNode;
CurNode^.SubNodes[i]^.Data := Result^.Data;
CurNode^.SubNodes[i].NameIndex := LPos;
CurNode^.SubNodes[i].NameSize := 1;
CurNode^.SubNodes[i].TextIndex := 0;
CurNode := CurNode^.SubNodes[i];
State := 2;
end;
end;
end;
Result^.NodesCount := k;
end;
function GetXMLNodeName(Node: PXMLNode): string;
begin
Result := Copy(Node^.Data^, Node^.NameIndex, Node^.NameSize);
end;
function GetXMLNodeText(Node: PXMLNode): string;
begin
Result := Copy(Node^.Data^, Node^.TextIndex, Node^.TextSize);
end;
function GetXMLNodeAttr(AttrName: string; Node: PXMLNode): string;
var
i: integer;
begin
Result := '';
if Length(Node^.Attributes) = 0 then
exit;
i := 0;
while (i < Length(Node^.Attributes))
and (AnsiLowerCase(AttrName) <> AnsiLowerCase(Trim(Copy(Node^.Data^,
Node^.Attributes[i].NameIndex, Node^.Attributes[i].NameSize)))) do
Inc(i);
Result := Copy(Node^.Data^, Node^.Attributes[i].TextIndex,
Node^.Attributes[i].TextSize);
end;
end.

Далее: Создание DTD для объекта (XML) »»