Парсер XML

Парсер XML

{ **** UBPFD *********** by kladovka.net.ru ****
>> Разбор XML
Данный прасер не такой универсальный, как предыдущий, за то - почти в 1000 раз эффективнее!
Зависимости: Windows, Forms, SysUtils, StrUtils
Автор: Delirium, <a href="mailto:VideoDVD@hotmail.com">VideoDVD@hotmail.com</a>, 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
  '<':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.

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...