Разбор XML

Delphi , Интернет и Сети , XML

Автор: 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.

Это модуль Delphi, который парсит файлы XML и предоставляет функции для извлечения информации из проанализированных данных.

Модуль содержит три основные компоненты:

1. TXMLTree: это корень XML-дерева, представляющий целый XML-документ. У него есть свойства, такие как Data, TextSize, NodesCount и Nodes, где Nodes - массив дочерних узлов.
2. TXMLNode: это одиночный узел в XML-дереве. У него есть свойства, такие как NameIndex, NameSize, Attributes, TextIndex, TextSize и Parent. Attributes - массив записей атрибутов, где каждая запись содержит информацию о атрибуте (например, его имя, размер, индекс текста и размер текста).

3. Функции, предоставляемые этим модулем:

4. BNFXMLTree: функция, которая принимает строковый ввод, представляющий XML-данные, и возвращает объект TXMLTree.

5. GetXMLNodeName: функция, которая принимает объект TXMLNode в качестве входных данных и возвращает имя узла в виде строки.
6. GetXMLNodeText: функция, которая принимает объект TXMLNode в качестве входных данных и возвращает текстовое содержимое узла в виде строки.
7. GetXMLNodeAttr: функция, которая принимает имя атрибута в виде строки, объект TXMLNode в качестве входных данных и возвращает значение атрибута в виде строки.

Модуль использует алгоритм рекурсивного спуска для парсинга XML-данных. Парсер начинает работу с корня дерева и проходит по символам вводной строки, обновляя состояние машины согласно правилам синтаксиса XML. Когда он встречает открывающий тег, создает новый узел и добавляет его в список дочерних узлов текущего узла. Когда он встречает закрывающий тег, рекурсивно спускается вниз по дереву, пока не найдет соответствующий открывающий тег.

Модуль также включает в себя некоторые механизмы обработки ошибок, такие как проверка на недопустимые символы в вводной строке и корректная обработка вложенных тегов.

В целом, этот модуль предоставляет основный XML-парсер, который может использоваться для извлечения информации из файлов XML. Однако он имеет некоторые ограничения, такие как не поддержка всех функций синтаксиса XML (например, именованных пространств и сущностей) и отсутствие механизмов отчета об ошибках за пределами простых возвращаемых значений.

В статье описывается реализация XML-парсера на языке Delphi, который позволяет разбирать и анализировать XML-строки, создавая объектную модель для представления их структуры и содержимого.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: XML ::