Разбор XML

Советы » XML » Разбор XML

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

.

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com