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