Delphi对XML的支持TXMLDocument类-2

看完了基础知识，下面就实践以下吧

本实例应用了MS的MSXML2_TLB，请自行查找下载

//用于读写XML的最简单的单元
unit XMLPurserUnit;

interface

uses
SysUtils, Classes, Windows, ActiveX, MSXML2_TLB;

type
//本例子通过DOM方式演示XML文件的读写过程
TDOMXMLpurser=class
public
{ 创建并保存XML文档，XMLDoc:=CoDOMDocument.Create没有办法将文档类型对象填加
到XMLDoc中，因为它没有引用相应的DTD}
procedure SavePropertiesToXML(Filename: string; Props: TStrings);
{ 解析已有的XML文档 }
//适用于节点名称不同的情况
procedure LoadPropertiesFromXML(Filename: string; Props: TStrings);
//适用于节点相同的情况
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 = 'movie';
Id = 'id';
Rating = 'rating';
StarringTag = 'starring';
TitleTag = 'title';
//保存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('焦点新闻'));
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, '123');
Movie.SetAttribute(Rating, '456');
AddSimpleElement(Movie, '789');
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格式
//Props.SaveToFile(Filename); //dos格式
finally
{ Release the DOM }
XMLDoc := nil;
end;
end;
//加载无重复属性的XML
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;
//加载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.

//调用XML读写
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.

//unit1对应的form

object Form1: TForm1
Left = 192
Top = 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 = {
4C0000002D2100004F2500000000000000000000000000000000000000000000
000000004C000000000000000000000001000000E0D057007335CF11AE690800
2B2E126208000000000000004C0000000114020000000000C000000000000046
8000000000000000000000000000000000000000000000000000000000000000
00000000000000000100000000000000000000000000000000000000}
end
object Memo1: TMemo
Left = 336
Top = 8
Width = 345
Height = 361
Lines.Strings = (
'星球大战1'
'星球大战2'
'星球大战3'
'星球大战前传1'
'星球大战前传2'
'星球大战前传3')
ScrollBars = ssBoth
TabOrder = 1
end
object Button1: TButton
Left = 192
Top = 384
Width = 147
Height = 25
Caption = 'LoadPropertiesFromXML'
TabOrder = 2
OnClick = Button1Click
end
object Button2: TButton
Left = 344
Top = 384
Width = 83
Height = 25
Caption = 'LoadFromXML'
TabOrder = 3
OnClick = Button2Click
end
object Button3: TButton
Left = 432
Top = 384
Width = 121
Height = 25
Caption = 'SavePropertiesToXML'
TabOrder = 4
OnClick = Button3Click
end
end

//一个最简单的XML文件 MailTemplate.xml
<?xml version="1.0"?>
<mailTemplate>
<smtp>
<host>mail.ncisystems.com</host>
<port/>
<user>keith</user>
<from>kbwood@thingies.com</from>
</smtp>
<database>
<alias>mailtemp</alias>
<user/>
<password/>
</database>
<settings>
<pauseTime>2000</pauseTime>
<template>MailMessage.xml</template>
<testing>Y</testing>
</settings>
</mailTemplate>