Парсер XML

=== Парсер XML ===
{ **** UBPFD *********** by kladovka.net.ru ****
>> Разбор XML
Данный прасер не такой универсальный, как предыдущий, за то - почти в 1000 раз эффективнее!
Зависимости: Windows, Forms, SysUtils, StrUtils
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
 '<': State := 12;
 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.
Author: Delirium
ID: 03114
Category:XML