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>[e-mail]</from>
  </smtp>
  <database>
    <alias>mailtemp</alias>
    <user/>
    <password/>
  </database>
  <settings>
    <pauseTime>2000</pauseTime>
    <template>MailMessage.xml</template>
    <testing>Y</testing>
  </settings>
</mailTemplate>