Delphi supports XML in txmldocument class-2

After reading the basic knowledge, let's practice the following:

Ms msxml2_tlb is applied to this instance. Please search for the download

// The simplest unit for reading and writing XML
Unit xmlpurserunit;

Interface

Uses
Sysutils, classes, windows, ActiveX, msxml2_tlb;

Type
// This example demonstrates the XML file read/write process through Dom.
Tdomxmlpurser = Class
Public
{Create and save the XML document. xmldoc: = codomdocument. Create cannot add the document type object
To xmldoc, because it does not reference the corresponding DTD}
Procedure savepropertiestoxml (filename: string; props: tstrings );
{Parse existing XML document}
// Applicable to different node names
Procedure loadpropertiesfromxml (filename: string; props: tstrings );
// Applicable to the same node Conditions
Procedure loadfromxml (filename: string; props: tstrings );
End;

Implementation

Const
Xmltag = 'xml ';
Xmlprologattrs = 'version = "1.0" encoding = "UTF-8 "';
Xmlcomment = 'sample XML document with data about movies '#13 +
'And when and where they are showing' #13 +
'Developed by Keith wood, 28 May 1999 ';
Moviewatchertag = 'movie-watcher ';
Moviestag = 'movies ';
Movietag = 'movi ';
Id = 'id ';
Rating = 'rating ';
Starringtag = 'starring ';
Titletag = 'title ';
// Save the XML
Procedure tdomxmlpurser. savepropertiestoxml (filename: string; props: tstrings );
VaR
Xmldoc: ixmldomdocument;
I: integer;
//----------------------------------------------------------------------------
Procedure addsimpleelement (parent: ixmldomelement; field: string;
Ascdata: Boolean = false );
VaR
Internal: ixmldomelement;
Begin
Internal: = ixmldomelement (parent. appendchild (
Xmldoc. createelement ('field. fieldname '))));
If ascdata then
Internal. appendchild (xmldoc. createcdatasection (field ))
Else
Internal. appendchild (xmldoc. createtextnode (field ));
End;
Procedure generateheaders;
VaR
Title: ixmldomelement;
Begin
Xmldoc. appendchild (xmldoc. createprocessinginstruction (xmltag, xmlprologattrs ));
Xmldoc. appendchild (xmldoc. createcomment (xmlcomment ));
Xmldoc. appendchild (xmldoc. createelement (moviewatchertag ));
Title: = ixmldomelement (xmldoc. documentelement. appendchild (
Xmldoc. createelement (titletag )));
Title. appendchild (xmldoc. createtextnode ('focus News '));
End;
Procedure generatestars (Starring: ixmldomelement );
Begin
Addsimpleelement (starring, '(Starfield )');
End;
Procedure generatemovies (moviename: string );
VaR
Movies, movie: ixmldomelement;
Begin
Movies: = ixmldomelement (xmldoc. documentelement. appendchild (
Xmldoc. createelement (moviestag )));
Movie: = ixmldomelement (movies. appendchild (
Xmldoc. createelement (movietag )));
Movie. setattribute (ID, '20140901 ');
Movie. setattribute (rating, '20140901 ');
Addsimpleelement (movie, '20140901 ');
Addsimpleelement (movie, moviename );
Addsimpleelement (movie, '"(directorfield )"');
Generatestars (ixmldomelement (movie. appendchild (
Xmldoc. createelement (starringtag ))));
Addsimpleelement (movie, 'fieldbyname (synopsisfield) ', true );
End;
//----------------------------------------------------------------------------
Begin
Try
Xmldoc: = codomdocument. Create;
Generateheaders;
I: = 0;
Repeat
Generatemovies (props. Strings [I]);
INC (I );
Until I> = props. count;
Props. Text: = xmldoc. xml;
Xmldoc. Save (filename); // u8-dos format
// Props. savetofile (filename); // DOS format
Finally
{Release the DOM}
Xmldoc: = nil;
End;
End;
// Load the XML without repeated attributes
Procedure tdomxmlpurser. loadpropertiesfromxml (filename: string; props: tstrings );
VaR
Xmldoc: ixmldomdocument;
I: integer;
Procedure loadsubproperties (element: ixmldomnode; propprefix: string );
VaR
Index: integer;
Begin
If (element. nodetype = node_text) or (element. nodetype = node_cdata_section) then
Props. Values [Copy (propprefix, 2, length (propprefix)-1)]: = element. nodevalue
Else
For index: = 0 to element. childnodes. Length-1 do
Loadsubproperties (element. childnodes [Index], propprefix + '.' + element. nodename );
End;
Begin
Xmldoc: = codomdocument. Create;
Props. Clear;
Try
If xmldoc. Load (filename) then
With xmldoc. documentelement do
For I: = 0 to childnodes. Length-1 do
Loadsubproperties (childnodes [I], '');
Finally
Xmldoc: = nil;
End;
End;
// Load XML
Procedure tdomxmlpurser. loadfromxml (filename: string; props: tstrings );
VaR
Xmldoc: ixmldomdocument;
I: integer;
Procedure loadsubproperties (element: ixmldomnode; propprefix: string );
VaR
Index: integer;
Begin
If (element. nodetype = node_text) or (element. nodetype = node_cdata_section) then
Props. Add (copy (propprefix, 2, length (propprefix)-1) + '=' + element. nodevalue)
Else
For index: = 0 to element. childnodes. Length-1 do
Loadsubproperties (element. childnodes [Index], propprefix + '.' + element. nodename );
End;
Begin
Xmldoc: = codomdocument. Create;
Props. Clear;
Try
If xmldoc. Load (filename) then
With xmldoc. documentelement do
For I: = 0 to childnodes. Length-1 do
Loadsubproperties (childnodes [I], '');
Finally
Xmldoc: = nil;
End;
End;

Initialization
{Initialise com}
Coinitialize (NiL );
Finalization
{Tidy up}
Couninitialize ();
End.

// Call XML read/write
Unit unit1;

Interface

Uses
Windows, messages, sysutils, variants, classes, graphics, controls, forms,
Dialogs, stdctrls, olectrls, shdocvw, xmlpurserunit;

Type
Tform1 = Class (tform)
Webbrowser1: twebbrowser;
Memo1: tmemo;
Button1: tbutton;
Button2: tbutton;
Button3: tbutton;
Procedure button1click (Sender: tobject );
Procedure formcreate (Sender: tobject );
Procedure formdestroy (Sender: tobject );
Procedure button2click (Sender: tobject );
Procedure button3click (Sender: tobject );
Private
{Private Declarations}
Fxmlpurser: tdomxmlpurser;
Public
{Public declarations}
End;

VaR
Form1: tform1;

Implementation

{$ R *. DFM}

Procedure tform1.formcreate (Sender: tobject );
Begin
Fxmlpurser: = tdomxmlpurser. Create;
End;

Procedure tform1.formdestroy (Sender: tobject );
Begin
Fxmlpurser. Free;
End;

Procedure tform1.button1click (Sender: tobject );
VaR
Filename: string;
Begin
Memo1.lines. Clear;
Filename: = extractfilepath (application. exename) + 'mailtemplate. xml ';

Fxmlpurser. loadpropertiesfromxml (filename, memo1.lines );
End;
 
Procedure tform1.button2click (Sender: tobject );
VaR
Filename: string;
Begin
Memo1.lines. Clear;
Filename: = extractfilepath (application. exename) + 'mailtemplate. xml ';

Fxmlpurser. loadfromxml (filename, memo1.lines );
End;

Procedure tform1.button3click (Sender: tobject );
Begin
Fxmlpurser. savepropertiestoxml (extractfilepath (application. exename) + 'mailtemplate1. xml', memo1.lines );
End;

End.

// Form corresponding to unit1

Object form1: tform1
Left = 1, 192
Maximum = 107
Width = 696
Height = 480
Caption = 'form1'
Color = clbtnface
Font. charset = default_charset
Font. Color = clwindowtext
Font. Height =-11
Font. Name = 'Ms sans serif'
Font. Style = []
Oldcreateorder = false
Oncreate = formcreate
Ondestroy = formdestroy
Pixelsperinch = 96
Textheight = 13
Object webbrowser1: twebbrowser
Left = 8
Top = 8
Width = 321
Height = 361
Taborder = 0
Controldata = {
4c0000002d200004f250000000000000000000000000000000000000000000000000000
2017100004c00000000000000000000000000e0d057007335cf11ae690800
2b2e1262080000000000000000004c0000000114020000000000c0000000000000000046
8000000000000000000000000000000000000000000000000000000000000000
00000000000000000100000000000000000000000000000000000000}
End
Object memo1: tmemo
Left = 1, 336
Top = 8
Width = 345
Height = 361
Lines. Strings = (
'Star Wars 1'
'Star Wars 2'
'Star Wars 3'
'Star Wars prequel 1'
'Star Wars prequel 2'
'Star Wars prequel 3 ')
Scrollbars = ssboth
Taborder = 1
End
Object button1: tbutton
Left = 1, 192
Maximum = 384
Width = 147
Height = 25
Caption = 'loadpropertiesfromxml'
Taborder = 2
Onclick = button1click
End
Object button2: tbutton
Left = 1, 344
Maximum = 384
Width = 83
Height = 25
Caption = 'loadfromxml'
Taborder = 3
Onclick = button2click
End
Object button3: tbutton
Left = 1, 432
Maximum = 384
Width = 121
Height = 25
Caption = 'savepropertiestoxml'
Taborder = 4
Onclick = button3click
End
End

// The simplest XML file mailtemplate. xml
<? XML version = "1.0"?>
<Mailtemplate>
<SMTP>
<Host> mail.ncisystems.com <Port/>
<User> Keith </user>
<From> kbwood@thingies.com </from>
</SMTP>
<Database>
<Alias> mailtemp </alias>
<User/>
<Password/>
</Database>
<Settings>
& Lt; pausetime & gt; 2000 & lt;/pausetime & gt;
<Template> mailmessage. xml </template>
<Testing> Y </testing>
</Settings>
</Mailtemplate>