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 г. ***************************************************** } unitBNFXMLParser2; 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
.