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

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Разбор XML

Данный прасер не такой универсальный, как предыдущий,
за то - почти в 1000 раз эффективнее!

Зависимости: Windows, Forms, SysUtils, StrUtils
Автор:       Delirium, VideoDVD@hotmail.com, 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.