Недавно добавленные исходники

•  TDictionary Custom Sort  2 693

•  Fast Watermark Sources  2 562

•  3D Designer  4 208

•  Sik Screen Capture  2 869

•  Patch Maker  3 078

•  Айболит (remote control)  2 905

•  ListBox Drag & Drop  2 505

•  Доска для игры Реверси  74 727

•  Графические эффекты  3 327

•  Рисование по маске  2 544

•  Перетаскивание изображений  2 131

•  Canvas Drawing  2 206

•  Рисование Луны  2 139

•  Поворот изображения  1 711

•  Рисование стержней  1 742

•  Paint on Shape  1 221

•  Генератор кроссвордов  1 809

•  Головоломка Paletto  1 452

•  Теорема Монжа об окружностях  1 817

•  Пазл Numbrix  1 357

•  Заборы и коммивояжеры  1 618

•  Игра HIP  1 104

•  Игра Go (Го)  1 062

•  Симулятор лифта  1 232

•  Программа укладки плитки  1 014

•  Генератор лабиринта  1 327

•  Проверка числового ввода  1 092

•  HEX View  1 271

•  Физический маятник  1 141

•  Задача коммивояжера  1 173

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Разбор XML



Автор: Delirium

{ **** 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.




Похожие по теме исходники

Basic XML Tester

Creation XML

Askue (обработка XML)

Test XML XSD

 

INI XML Files




Copyright © 2004-2023 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте