Create and parse XML

Unit unit1;

Interface

Uses
Windows, messages, sysutils, variants, classes, graphics, controls, forms,
Dialogs, stdctrls, msxml_tlb, comobj, comctrls;

Type
Tform1 = Class (tform)
Button1: tbutton;
Button2: tbutton;
Tvxml: ttreeview;
Procedure button1click (Sender: tobject );
Procedure button2click (Sender: tobject );
Procedure tvxmlclick (Sender: tobject );
Private
{Private Declarations}
Public
{Public declarations}
End;

VaR
Form1: tform1;

Implementation

{$ R *. DFM}
// Create
Procedure tform1.button1click (Sender: tobject );
VaR
DOC: ixmldomdocument;
Root, {Child1, child2,} childtmp: ixmldomelement;
// Xmlatri: ixmldomattribute;
Procedure addsysnode (pelement: ixmldomelement; idepth: integer );
VaR
Child1: ixmldomelement;
I: integer;
Begin
Child1: = Doc. createelement ('sysnode' + inttostr (idepth ));
Child1.setattribute ('vol ', '123 ');
Child1.setattribute ('option', '2 ');
Child1.setattribute ('d d', '1 ');
Child1.setattribute ('no', '0 ');
Child1.setattribute ('num', '-1 ');
Pelement. appendchild (Child1 );

If idepth = 5 then
Begin
Exit;
End;

Addsysnode (Child1, idepth + 1 );

End;
Begin
DOC: = createoleobject ('Microsoft. xmldom ') as ixmldomdocument;
Root: = Doc. createelement ('SITE ');
Root. setattribute ('type', '7 ');
Doc. appendchild (Root );

Childtmp: = Doc. createelement ('systemnode1 ');
Childtmp. setattribute ('option', '2 ');
Childtmp. setattribute ('d d', '1 ');
Childtmp. setattribute ('no', '0 ');
Childtmp. setattribute ('num', '63 ');
Root. appendchild (childtmp );

Childtmp: = Doc. createelement ('systemnode2 ');
Childtmp. setattribute ('option', '2 ');
Childtmp. setattribute ('d d', '1 ');
Childtmp. setattribute ('no', '0 ');
Childtmp. setattribute ('num', '63 ');
Root. appendchild (childtmp );

Childtmp: = Doc. createelement ('systemnode ');
Childtmp. setattribute ('vol ', '123 ');
Childtmp. setattribute ('option', '2 ');
Childtmp. setattribute ('d d', '1 ');
Childtmp. setattribute ('no', '0 ');
Childtmp. setattribute ('num', '-1 ');
Root. appendchild (childtmp );

Addsysnode (childtmp, 0 );

Doc. Save ('e:/xmltest. xml ');
End;

// Resolution
Procedure tform1.button2click (Sender: tobject );
VaR
// I: integer;
DOC: ixmldomdocument;
Root: ixmldomnode;
Tvroot, curtvnode: ttreenode;
Treenodelist: tlist;
Atriarray: array [1 .. 6] of string; // attribute list Array
{
** Get the attribute value based on the passed property name
}
Function getatri (pnode: ixmldomnode; atriname, atroption: string): string;
VaR
Tmpatri1: ixmldomnode;
Begin
Tmpatri1: = pnode. Attributes. getnameditem (atriname );
If tmpatri1 <> nil then
Begin
If atroption = ''then
Begin
Atroption: = tmpatri1.nodename + '=' + tmpatri1.nodevalue;
End
Else
Begin
Atroption: = atroption + ',' + tmpatri1.nodename + '=' + tmpatri1.nodevalue;
End;
End;
Result: = atroption;
End;

{
** Recursively retrieve hierarchical nodes
}
Procedure addnode (pnode: ixmldomnode; ptvnode: ttreenode );
VaR
I: integer;
Tmproot, childtmp: ixmldomnode;
Bbrother: Boolean;
Atroption: string;
Begin
Bbrother: = false;
While (pnode <> nil) Do
Begin
Atroption: = '';

For I: = 1 to 6 do
Begin
Atroption: = getatri (pnode, atriarray [I], atroption );
End;

If not bbrother then
Begin
Ptvnode: = tvxml. Items. addchild (ptvnode, pnode. nodename + '(' + atroption + '); // Parent and Child Nodes
End
Else
Begin
Ptvnode: = tvxml. Items. Add (ptvnode, pnode. nodename + '(' + atroption + '); // sibling Node
End;
If pnode. childnodes. length> 0 then
Begin
Childtmp: = pnode. childnodes. item [0];
Addnode (childtmp, ptvnode );
// Ptvnode: = treenodelist.
End;
Pnode: = pnode. nextsibling;
Bbrother: = true;
End;
End;
Begin
DOC: = createoleobject ('Microsoft. xmldom ') as ixmldomdocument;
Doc. Load ('e:/xmltest. xml ');

// Attribute name
Atriarray [1]: = 'type ';
Atriarray [2]: = 'vol ';
Atriarray [3]: = 'option ';
Atriarray [4]: = 'd d ';
Atriarray [5]: = 'no ';
Atriarray [6]: = 'num ';

Root: = Doc. firstchild;
Addnode (root, nil );

End;

Procedure tform1.tvxmlclick (Sender: tobject );
VaR
Tvnode: ttreenode;
Begin
Tvnode: = tvxml. selected;

If tvnode. Text = '2' then
Exit;
End;

End.