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

Получить ссылку на материал