Delphi supports XML in txmldocument class-2

Source: Internet
Author: User

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>

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.