Delphi对XML的支持TXMLDocument类-3

来源：互联网发布：杰普软件编辑：程序博客网时间：2024/06/06 06:10

2.5 缩简句法
这是一些使用缩简句法的地址路径例子：

para 选择上下文节点的 para 元素孩子

* 选择上下文节点的所有的元素孩子

text() 选择上下文节点的所有的正文节点孩子

@name 选择上下文节点的 name 属性

@* 选择上下文节点的所有的属性

para[1] 选择上下文节点的第一个 para 孩子

para[last()] 选择上下文节点的最后一个 para 孩子

*/para 选择上下文节点的所有的 para 孙子

/doc/chapter[5]/section[2] 选择doc的第五个 chapter 的第二个 section

chapter//para 选择上下文节点的 chapter 元素孩子的所有 para 元素子孙

//para 选择文档根的所有的 para 子孙，也就是选择上下文节点所在的文档中所有的 para 元素

//olist/item 选择上下文节点所在的文档中所有的以 olist 为父的 item 元素

. 选择上下文节点

.//para 选择上下文节点的 para 元素子孙

.. 选择上下文节点的父

../@lang 选择上下文节点的父的 lang 属性

para[@type="warning"] 选择的上下文节点的所有的有属性 type 且值为 warning 的 para 孩子

para[@type="warning"][5] 选择的上下文节点的所有的有属性 type 且值为 warning 的 para 孩子中的第五个

para[5][@type="warning"] 选择的上下文节点的第五个 para 孩子如果该节点有属性 type 且值为 warning 的话

chapter[title="Introduction"] 选择上下文节点的 chapter 孩子如果它有一个或多个 title 孩子且字串值为 Introduction

chpater[title] 选择的上下文节点中有一个或一个以上 title 孩子的 chpater 孩子

employee[@secretary and @assistant] 选择上下文节点的所有既有 secretary 属性又有 assistant 属性的 employee 孩子

最重要的缩写是 child:: 能从地点步进省略掉。实际效果上，child 是缺省轴。例如，地址路径 div/para 是 child::div/child::para 的缩写。

属性也有缩写形式： attribute:: 能被缩写成 @。例如，地址路径 para[@type="warning"] 为 child::para[attribute::type="warning"] 的缩写，也就是选择有 type 属性且属性值为 warning 的 para 孩子。

// 是 /descendant-or-self::node()/ 的缩写。例如，//para 是 /descendant-or-self::node()/child::para 的缩写，因此选择文档中所有的 para 元素（即使 para 元素是文档元素，也会被 //para 所选择，因为文档元素是根节点的孩子）； div//para 是 div/descendant-or-self::node()/child::para 的缩写，因此将选择 div 孩子的所有 para 子孙。

注意：

地址路径 //para[1] 与地址路径 /descendant::para[1] 的含意不一样，后者选择第一个 para 元素子孙，前者选择是他们的父的第一 para 孩子的所有的子孙 para 元素。

地点路进 . 是 self::node() 的缩写。这与 // 一起使用特别有用。例如，地址路径 .//para 是 self::node()/descendant-or-self::node()/child::para 的缩写，因此将选择上下文节点的所有的 para 子孙元素。

同样，地址路径 .. 是 parent::node() 的缩写。例如，../title 是 parent::node()/child::title 的缩写因此这将选择上下文节点的父的 title 孩子。

2005-9-23 21:05:34 xml基础操作实例，因为刚开始学，如果有不对的地方，请批评指正，代码如下：

unit XMLOptionUnit;
//==============================================================================
//本实例演示
//1，XML 创建，打开，关闭操作
//2，XML 填加，添加到指定位置，删除，修改（替换），查找等操作
//作者：cactus123456@hotmail.com
//日期：2005.9.23
//版本：1.0
//==============================================================================
interface

uses
SysUtils,ActiveX,MSXML2_TLB;

type
RecUser=Record
    U_Id       :widestring;
    U_Name     :widestring;
    U_Sex      :widestring;
    U_Birth    :widestring;
    U_Tel      :widestring;
    U_Addr     :widestring;
    U_PostCode :widestring;
    U_Email    :widestring;
end;

type
TXMLOption=class
private
    FActive :boolean;
    FFilename: string;
    FXMLDoc :IXMLDOMDocument;
    //填加一个子节点
    procedure AddSimpleElement(Parent: IXMLDOMElement; Field,Value: string);
public
    procedure CreateBlank(Filename: string);
    procedure OpenXml(Filename: string);
    procedure CloseXml;
    procedure AppendUser(muser:RecUser);
    procedure InsertUser(uid:string;muser:RecUser);
    procedure RemoveUser(uid:string);
    procedure ReplaceUser(uid:string;newuser:RecUser);
    function FindUser(userid:widestring):boolean;
end;

implementation

const
XMLTag          = 'xml';
XMLPrologAttrs = 'version="1.0" encoding="UTF-8"';
XMLComment      = '简单XML文档操作用户实例'#13 +
                    '用户结构为序号，姓名，性别，出生年月日，电话，住址，邮编，电邮'#13 +
                    '作者 cactus123456@hotmail.com, 2005.9.21';
UserWatcherTag = 'user-watcher';
XMLComment2    = '创建文档时间：';
UsersTag       = 'users';
U_Id           = 'id';
U_Name         = 'name';
U_Sex          = 'sex';
U_Birth        = 'birth';
U_Tel          = 'tel';
U_Addr         = 'addr';
U_PostCode     = 'postcode';
U_Email        = 'email';

//创建一个空XML，如果这个Filename文件已经存在，则覆盖
procedure TXMLOption.CreateBlank(Filename: string);
begin
FActive:=false;
FFilename:='';
try
    FXMLDoc := CoDOMDocument.Create;
    FXMLDoc.AppendChild(FXMLDoc.CreateProcessingInstruction(XMLTag, XMLPrologAttrs));
    FXMLDoc.AppendChild(FXMLDoc.CreateComment(XMLComment));
    FXMLDoc.AppendChild(FXMLDoc.CreateElement(UserWatcherTag));
    FXMLDoc.AppendChild(FXMLDoc.CreateComment(XMLComment2+datetimetostr(now)));
    FXMLDoc.save(Filename);
    FFilename:=Filename;
    FActive:=true;
except
    FXMLDoc:=nil;
end;
end;
//打开一个存在的Filename XML文档
procedure TXMLOption.OpenXml(Filename: string);
begin
if not Assigned(FXMLDoc) then
begin
    FXMLDoc := CoDOMDocument.Create;
    if FXMLDoc.Load(Filename) then FActive:=true
    else FActive:=false;
    if FActive then FFilename:=Filename
    else FFilename:='';
end;
end;
//关闭一个打开的XML文档
procedure TXMLOption.CloseXml;
begin
if Assigned(FXMLDoc) then FXMLDoc:=nil;
FFilename:='';
FActive:=false;
end;
procedure TXMLOption.AddSimpleElement(Parent: IXMLDOMElement; Field,Value: string);
var
Internal: IXMLDOMElement;
begin
Internal:=IXMLDOMElement(Parent.AppendChild(FXMLDoc.CreateElement(Field)));
Internal.AppendChild(FXMLDoc.CreateTextNode(Value));
end;
//填加一个节点到后面
procedure TXMLOption.AppendUser(muser:RecUser);
var
xuser:IXMLDOMElement;
xroot:IXMLDOMElement;
begin
if FActive then
begin
    xroot:=FXMLDoc.documentElement;
    xuser :=IXMLDOMElement(xroot.AppendChild(FXMLDoc.CreateElement(UsersTag)));
    AddSimpleElement(xuser,U_Id,muser.U_Id);
    AddSimpleElement(xuser,U_Name,muser.U_Name);
    AddSimpleElement(xuser,U_Sex,muser.U_Sex);
    AddSimpleElement(xuser,U_Birth,muser.U_Birth);
    AddSimpleElement(xuser,U_Tel,muser.U_Tel);
    AddSimpleElement(xuser,U_Addr,muser.U_Addr);
    AddSimpleElement(xuser,U_PostCode,muser.U_PostCode);
    AddSimpleElement(xuser,U_Email,muser.U_Email);
    FXMLDoc.save(FFilename);
end;
end;
procedure TXMLOption.InsertUser(uid:string;muser:RecUser);
var
xfind:IXMLDOMNode;
xuser:IXMLDOMElement;
xroot:IXMLDOMElement;
xpath:string;
begin
if not FActive then exit;
xpath:=UsersTag+'['+U_Id+'="'+uid+'"]';
xfind:=FXMLDoc.documentElement.selectSingleNode(xpath);
//如果没有找到， xfind=nil 则在文件的末尾插入
//如果找到，xfind<>nil 则在找到的纪录前面插入
xroot:=FXMLDoc.documentElement;
xuser :=IXMLDOMElement(xroot.insertBefore(FXMLDoc.CreateElement(UsersTag),xfind));
AddSimpleElement(xuser,U_Id,muser.U_Id);
AddSimpleElement(xuser,U_Name,muser.U_Name);
AddSimpleElement(xuser,U_Sex,muser.U_Sex);
AddSimpleElement(xuser,U_Birth,muser.U_Birth);
AddSimpleElement(xuser,U_Tel,muser.U_Tel);
AddSimpleElement(xuser,U_Addr,muser.U_Addr);
AddSimpleElement(xuser,U_PostCode,muser.U_PostCode);
AddSimpleElement(xuser,U_Email,muser.U_Email);
FXMLDoc.save(FFilename);
end;
procedure TXMLOption.RemoveUser(uid:string);
var
xfind:IXMLDOMNode;
xroot:IXMLDOMElement;
xpath:string;
begin
if not FActive then exit;
xpath:=UsersTag+'['+U_Id+'="'+uid+'"]';
xfind:=FXMLDoc.documentElement.selectSingleNode(xpath);
if xfind<>nil then
begin
    xroot:=FXMLDoc.documentElement;
    xroot.removeChild(xfind);
    FXMLDoc.save(FFilename);
end;
end;
procedure TXMLOption.ReplaceUser(uid:string;newuser:RecUser);
var
xfind,newnode:IXMLDOMNode;
xroot:IXMLDOMElement;
xpath:string;
begin
if not FActive then exit;
xpath:=UsersTag+'['+U_Id+'="'+uid+'"]';
xfind:=FXMLDoc.documentElement.selectSingleNode(xpath);
//如果没有找到，则不做替换
if xfind<>nil then
begin
    newnode:=xfind.cloneNode(true);
    newnode.selectSingleNode(U_Id).text:=newuser.U_Id;
    newnode.selectSingleNode(U_Name).text:=newuser.U_Name;
    newnode.selectSingleNode(U_Sex).text:=newuser.U_Sex;
    newnode.selectSingleNode(U_Birth).text:=newuser.U_Birth;
    newnode.selectSingleNode(U_Tel).text:=newuser.U_Tel;
    newnode.selectSingleNode(U_Addr).text:=newuser.U_Addr;
    newnode.selectSingleNode(U_PostCode).text:=newuser.U_PostCode;
    newnode.selectSingleNode(U_Email).text:=newuser.U_Email;
    xroot:=FXMLDoc.documentElement;
    xroot.replaceChild(newnode,xfind);
    FXMLDoc.save(FFilename);
end;
end;
function TXMLOption.FindUser(userid:widestring):boolean;
var
xuser:IXMLDOMNode;
xpath:string;
begin
result:=false;
if not FActive then exit;
//关于xpath语法说明，参见www.w3.org/TR/xpath
xpath:=UsersTag+'['+U_Id+'="'+userid+'"]';
xuser:=FXMLDoc.documentElement.selectSingleNode(xpath);
if xuser<>nil then result:=true;
end;

initialization
{ Initialise COM }
CoInitialize(nil);
finalization
{ Tidy up }
CoUninitialize();

end.

调用上面单元的实例的代码，unit单元：

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,XMLOptionUnit, OleCtrls, SHDocVw;

type
TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    WebBrowser1: TWebBrowser;
    Label1: TLabel;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
private
    { Private declarations }
    FXMLOption:TXMLOption;
public
    { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
FXMLOption:=TXMLOption.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
FXMLOption.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
FXMLOption.CreateBlank(edit1.Text);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
auser:RecUser;
begin
auser.U_Id:=edit2.Text;
auser.U_Name:='tom';
auser.U_Sex:='男';
auser.U_Birth:='1979-8-7';
auser.U_Tel:='1236547890';
auser.U_Addr:='tom 大街 8 号';
auser.U_PostCode:='100018';
auser.U_Email:='tom@888.com';
FXMLOption.AppendUser(auser);
WebBrowser1.Navigate(ExtractFilePath(application.ExeName)+edit1.Text);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
FXMLOption.OpenXml(edit1.Text);
WebBrowser1.Navigate(ExtractFilePath(application.ExeName)+edit1.Text);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
FXMLOption.CloseXml;
WebBrowser1.Navigate('about:blank');
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
if FXMLOption.FindUser(edit2.text) then label1.Caption:='true'
else label1.Caption:='false';
end;

procedure TForm1.Button6Click(Sender: TObject);
var
auser:RecUser;
begin
auser.U_Id:=edit2.Text;
auser.U_Name:='peter';
auser.U_Sex:='女';
auser.U_Birth:='1980-8-7';
auser.U_Tel:='36-3654-7890';
auser.U_Addr:='peter 大街 8 号';
auser.U_PostCode:='100018';
auser.U_Email:='peter@888.com';
FXMLOption.InsertUser(edit2.text,auser);
WebBrowser1.Navigate(ExtractFilePath(application.ExeName)+edit1.Text);
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
FXMLOption.RemoveUser(edit2.text);
WebBrowser1.Navigate(ExtractFilePath(application.ExeName)+edit1.Text);
end;

procedure TForm1.Button8Click(Sender: TObject);
var
auser:RecUser;
begin
auser.U_Id:=edit2.Text;
auser.U_Name:='张三';
auser.U_Sex:='男';
auser.U_Birth:='1970-8-7';
auser.U_Tel:='001654-7890';
auser.U_Addr:='张三大街 8 号';
auser.U_PostCode:='100018';
auser.U_Email:='zhangsan@888.com';
FXMLOption.ReplaceUser(edit2.Text,auser);
WebBrowser1.Navigate(ExtractFilePath(application.ExeName)+edit1.Text);
end;

end.

Unit单元对应的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 Label1: TLabel
    Left = 440
    Top = 400
    Width = 32
    Height = 13
    Caption = 'Label1'
end
object Button1: TButton
    Left = 256
    Top = 360
    Width = 75
    Height = 25
    Caption = 'CreateBlank'
    TabOrder = 0
    OnClick = Button1Click
end
object Button2: TButton
    Left = 352
    Top = 360
    Width = 75
    Height = 25
    Caption = 'AddUser'
    TabOrder = 1
    OnClick = Button2Click
end
object Edit1: TEdit
    Left = 208
    Top = 328
    Width = 121
    Height = 21
    TabOrder = 2
    Text = 'userxml.xml'
end
object Edit2: TEdit
    Left = 352
    Top = 328
    Width = 121
    Height = 21
    TabOrder = 3
    Text = '900'
end
object Button3: TButton
    Left = 256
    Top = 384
    Width = 75
    Height = 25
    Caption = 'OpenXml'
    TabOrder = 4
    OnClick = Button3Click
end
object Button4: TButton
    Left = 256
    Top = 408
    Width = 75
    Height = 25
    Caption = 'CloseXml'
    TabOrder = 5
    OnClick = Button4Click
end
object Button5: TButton
    Left = 352
    Top = 392
    Width = 75
    Height = 25
    Caption = 'FindUser'
    TabOrder = 6
    OnClick = Button5Click
end
object WebBrowser1: TWebBrowser
    Left = 0
    Top = 0
    Width = 688
    Height = 313
    Align = alTop
    TabOrder = 7
    ControlData = {
      4C0000001B470000592000000000000000000000000000000000000000000000
      000000004C000000000000000000000001000000E0D057007335CF11AE690800
      2B2E126208000000000000004C0000000114020000000000C000000000000046
      8000000000000000000000000000000000000000000000000000000000000000
      00000000000000000100000000000000000000000000000000000000}
end
object Button6: TButton
    Left = 432
    Top = 360
    Width = 75
    Height = 25
    Caption = 'InsertUser'
    TabOrder = 8
    OnClick = Button6Click
end
object Button7: TButton
    Left = 512
    Top = 360
    Width = 75
    Height = 25
    Caption = 'RemoveUser'
    TabOrder = 9
    OnClick = Button7Click
end
object Button8: TButton
    Left = 512
    Top = 392
    Width = 75
    Height = 25
    Caption = 'ReplaceUser'
    TabOrder = 10
    OnClick = Button8Click
end
end