Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...
{ **** 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
.