Как сделать калькулятор в Delphi?
Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Как Delphi реализует многоплатформенную разработку?
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...
Парсер подавляющего большинства нотаций XML
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Парсер подавляющего большинства нотаций XML.
Для задачи десериализации мне потребовался парсер.
Основное преимущество - никак не связан с операционной системой
(в отличие от TXMLDocument), ну и разумеется - простота :)
Зависимости: SysUtils, StrUtils
Автор: Delirium, VideoDVD@hotmail.com, ICQ:118395746, Москва
Copyright: Delirium (Master BRAIN) 2003
Дата: 16 сентября 2003 г.
***************************************************** }
unit BNFXMLParser;
interface
uses
SysUtils, StrUtils;
type
PXMLNode = ^TXMLNode;
TXMLValues = (TextNode, XMLNode);
TXMLNode = record
Name: string
;
Attributes: array
of
record
Name: string
;
Value: string
;
end
;
SubNodes: array
of
record
RecType: TXMLValues;
case
TXMLValues of
TextNode: (Text: PString);
XMLNode: (XML: PXMLNode);
end
;
Parent: PXMLNode;
end
;
function
BNFXMLTree(var
Value: string
): PXMLNode;
implementation
function
fnTEG(var
Node: PXMLNode; var
Value: string
): boolean; forward
;
function
fnVAL(var
Node: PXMLNode; var
Value: string
): boolean; forward
;
function
fnATT(var
Node: PXMLNode; var
Value: string
): boolean; forward
;
function
fnXML(var
Node: PXMLNode; var
Value: string
): boolean;
var
i: integer;
begin
if
(Pos('<', Value) > 0)
and
(Pos('>', Value) > Pos('<', Value))
and
(Pos('<', Value) <> Pos('</', Value)) then
begin
// Оганизую узел
if
Node = nil
then
begin
New(Node);
Node.Parent := nil
;
end
else
begin
i := length(Node.SubNodes);
Setlength(Node.SubNodes, i + 1);
New(Node.SubNodes[i].XML);
Node.SubNodes[i].RecType := XMLNode;
Node.SubNodes[i].XML.Parent := Node;
Node := Node.SubNodes[i].XML;
end
;
Result := fnTEG(Node, Value);
end
// '<'
else
Result := True;
end
;
function
fnTEG(var
Node: PXMLNode; var
Value: string
): boolean;
var
i, i1, i2, i3: integer;
S: string
;
begin
Result := False;
i1 := Pos('<', Value);
if
i1 > 0 then
begin
i2 := PosEx('/>', Value, i1);
i3 := PosEx('>', Value, i1);
if
(i2 > 0) and
(i2 < i3) then
begin
// <abc/>
// Value
S := Copy(Value, i1 + 1, (i2 - i1) - 1);
Delete(Value, i1, (i2 - i1) + 2);
// TEXT, этот текст пренадлежит предку
if
Node.Parent <> nil
then
begin
// Добавляюсь к предку
i := length(Node.Parent.SubNodes);
Setlength(Node.Parent.SubNodes, i + 1);
New(Node.Parent.SubNodes[i].Text);
Node.Parent.SubNodes[i].RecType := TextNode;
Node.Parent.SubNodes[i].Text^ := Copy(Value, 1, Pos('<', Value) - 1);
end
;
Delete(Value, 1, Pos('<', Value) - 1);
//
if
fnVAL(Node, S) then
begin
// Вложенных тегов не бывает
Node := Node.Parent;
Result := fnXML(Node, Value);
end
;
end
else
begin
// <abc>...</abc>
// Value
S := Copy(Value, i1 + 1, (i3 - i1) - 1);
Delete(Value, i1, (i3 - i1) + 1);
// TEXT
i := length(Node.SubNodes);
Setlength(Node.SubNodes, i + 1);
New(Node.SubNodes[i].Text);
Node.SubNodes[i].RecType := TextNode;
Node.SubNodes[i].Text^ := Copy(Value, 1, Pos('<', Value) - 1);
Delete(Value, 1, Pos('<', Value) - 1);
//
if
fnVAL(Node, S) then
begin
// Val
// Проверяю закрытие тега, удаляю хвост и передаю управление предку
if
Pos('</' + AnsiLowerCase(Node.Name) + '>', AnsiLowerCase(Value)) = 1
then
begin
Delete(Value, 1, Length('</' + Node.Name + '>'));
// TEXT принадлежащий предку
if
Node.Parent <> nil
then
begin
// Добавляюсь к предку
i := length(Node.Parent.SubNodes);
Setlength(Node.Parent.SubNodes, i + 1);
New(Node.Parent.SubNodes[i].Text);
Node.Parent.SubNodes[i].RecType := TextNode;
Node.Parent.SubNodes[i].Text^ := Copy(Value, 1, Pos('<', Value) -
1);
end
;
Delete(Value, 1, Pos('<', Value) - 1);
Node := Node.Parent;
Result := fnXML(Node, Value);
end
else
begin
// Обрабатываю вложенные теги, на выходе мой узел
if
fnXML(Node, Value) then
begin
// закрываю его
if
Pos('</' + AnsiLowerCase(Node.Name) + '>', AnsiLowerCase(Value))
= 1 then
begin
Delete(Value, 1, Length('</' + Node.Name + '>'));
// TEXT принадлежащий предку
if
Node.Parent <> nil
then
begin
// Добавляюсь к предку
i := length(Node.Parent.SubNodes);
Setlength(Node.Parent.SubNodes, i + 1);
New(Node.Parent.SubNodes[i].Text);
Node.Parent.SubNodes[i].RecType := TextNode;
Node.Parent.SubNodes[i].Text^ := Copy(Value, 1, Pos('<', Value)
- 1);
end
;
Delete(Value, 1, Pos('<', Value) - 1);
end
;
// Остальной XML - предку
if
Node.Parent <> nil
then
Node := Node.Parent;
Result := fnXML(Node, Value);
end
;
end
;
end
; // Val
end
; // <abc>...</abc>
end
; // i1
end
;
function
fnVAL(var
Node: PXMLNode; var
Value: string
): boolean;
begin
Value := AnsiReplaceStr(Value, '''', '"');
if
(Pos(' ', Value) > 0)
and
(Pos('="', Value) > Pos(' ', Value)) then
begin
Node.Name := Trim(Copy(Value, 1, Pos(' ', Value) - 1)); // Название тега Name
Delete(Value, 1, Pos(' ', Value));
Result := fnATT(Node, Value);
end
// ' ' и ('="'
else
begin
// Название тега Name
Value := Trim(Value);
if
Pos(' ', Value) > 0 then
Node.Name := Copy(Value, 1, Pos(' ', Value) - 1)
else
Node.Name := Value;
Value := '';
Result := True;
end
;
end
;
function
fnATT(var
Node: PXMLNode; var
Value: string
): boolean;
begin
Result := True;
Value := Trim(Value);
if
Pos('="', Value) > 0 then
begin
Result := False;
SetLength(Node.Attributes, Length(Node.Attributes) + 1);
// Название атрибута
Node.Attributes[Length(Node.Attributes) - 1].Name := Trim(Copy(Value, 1,
Pos('="', Value) - 1));
Delete(Value, 1, Pos('="', Value) + 1);
if
Pos('"', Value) > 0 then
begin
// Значение атрибута
Node.Attributes[Length(Node.Attributes) - 1].Value := Copy(Value, 1,
Pos('"', Value) - 1);
Delete(Value, 1, Pos('"', Value));
if
Length(Value) > 0 then
Result := fnATT(Node, Value)
else
Result := True;
end
;
end
;
end
;
function
BNFXMLTree(var
Value: string
): PXMLNode;
begin
Result := nil
;
fnXML(Result, Value);
end
;
end
.
Пример использования:
procedureTForm1.Button1Click(Sender: TObject); var
S: string
; Node: PXMLNode; i: integer; begin
S := '<A> aaa1 ' + #13 + ' aaa2 aaa3 ' + #13 + ' <B>bbb ' + #13 + ' <C>ccc</C> ' + #13 + ' </B> ' + #13 + ' <D>ddd ' + #13 + ' <E eee="EEE"/> ' + #13 + ' </D> ' + #13 + '</A> '; Node := BNFXMLTree(S); for
i := 0 to
Length(Node.SubNodes) - 1 do
case
Node.SubNodes[i].RecType of
TextNode: ShowMessage('Text = ' + Node.SubNodes[i].Text^); XMLNode: ShowMessage('XML Node name = ' + Node.SubNodes[i].XML.Name); end
; end
;