[infopol]

Давно хотел сделать парсинг любого XML,превратив в массив переменных.
Нашел такой unit

Код:

{ **** 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,Winapi.Messages, Vcl.dialogs;

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;

//  ShowMessage()IntToStr(Pos('<', Value)));
//Exit;
  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 World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.

Нарисовал простейщий код

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
i:Integer;
P_Xmlnodes:array of pxmlnode;
 XMLTree: TXMLTree;
 P_XMLTree: PXMLTree;
xmlstr:string;
begin
Memo1.Clear;
       //   New( P_XMLTree);

//Edit1.text:='c:\zakaz.xml';
   if FileExists(Edit1.Text) then
   begin
//TFile.Create(edit1.text);
                  //  AnsiToUtf8()
 xmlstr:=    AnsiToUtf8( TFile.ReadAllText(edit1.text));
//Memo1.Text:=xmlstr;
  //      ShowMessage('1111');
//      label1.Caption:=IntToStr(xmlstr.Length );
  P_XMLTree:=   BNFXMLTree(xmlstr);

         XMLTree:=P_XMLTree^;
   Memo1.Text:= XMLTree.Data^;
     label1.Caption:=          IntToStr( P_XMLTree.NodesCount);
//   GetXMLNodeText(
SetLength(P_XMLNodes,P_XMLTree.NodesCount+1);
//Вот тут ошибка передачи в переменную
//P_XMLNodes:=XMLTree.Nodes;

//New(P_XMLNodes);
// XMLTree.;
// XMLTree. ;
for I := 0 to P_XMLTree.NodesCount do
begin


//P_XMLTree.Nodes;


end;

Вот тут ошибка передачи в переменную P_XMLNodes:=XMLTree.Nodes;
как устранить эту ошибку?

[infopol]

Код:

for I := 0 to Length(XMLTree.Nodes)-1 do
begin
 p_node:=     XMLTree.Nodes[i]  ;
     //  p_node.
    // t_node:=p_node^;

//  XMLTree.Nodes[i].TextSize;
       pData:=p_node.Data;
//

LBytes :=nil;
LBytes:=BytesOf(pData^);
//  LBytes:=TEncoding.Convert(TEncoding.UTF8, TEncoding.ASCII, LBytes);

//     UnicodeToUTF8(PWideChar(pData^),Dates,Length(pData)+1);
      name:= GetXMLNodeName( p_node);
text:= GetXMLNodeText(p_node);
attr:= GetXMLNodeAttr(name,p_node);
Memo1.Lines.Add(IntToStr(i)+' '+AnsiToUTF8(  StringOf(LBytes)){+IntToStr( p_node.TextSize)});
{for xmlattr in p_node.Attributes do
  begin

  //    Memo1.Lines.Add()
  end;
 }
//P_XMLTree.Nodes;


end;

Почему то не получается вывести все дерево атрибутов,выводится все значение файла