思享工具箱

delphi 操作xml示例（DelphiBBS）

摘要：
自：http://www.delphibbs.com/keylife/iblog_show.asp?xid=20713================================================================2005-9-2321:05:34xml基础操作实例，因为刚开始学，如果有不对的地方，请批评指正，代码如下：unitXMLOptionUnit;//===
自：http://www.delphibbs.com/keylife/iblog_show.asp?xid=20713
================================================================
2005-9-23 21:05:34xml基础操作实例，因为刚开始学，如果有不对的地方，请批评指正，代码如下：
unitXMLOptionUnit;
//==============================================================================
//本实例演示
//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);
    procedureCloseXml;
    procedureAppendUser(muser:RecUser);
    procedure InsertUser(uid:string;muser:RecUser);
    procedure RemoveUser(uid:string);
    procedure ReplaceUser(uid:string;newuser:RecUser);
    functionFindUser(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文档
procedureTXMLOption.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;
//填加一个节点到后面
procedureTXMLOption.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 thenexit;
  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 thenexit;
  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 thenexit;
  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;
functionTXMLOption.FindUser(userid:widestring):boolean;
var
  xuser:IXMLDOMNode;
  xpath:string;
begin
  result:=false;
  if not FActive thenexit;
  //关于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单元：
unitUnit1;
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;
    procedureFormCreate(Sender: TObject);
    procedureFormDestroy(Sender: TObject);
    procedureButton1Click(Sender: TObject);
    procedureButton2Click(Sender: TObject);
    procedureButton3Click(Sender: TObject);
    procedureButton4Click(Sender: TObject);
    procedureButton5Click(Sender: TObject);
    procedureButton6Click(Sender: TObject);
    procedureButton7Click(Sender: TObject);
    procedureButton8Click(Sender: TObject);
  private
    {Private declarations }
    FXMLOption:TXMLOption;
  public
    {Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedureTForm1.FormCreate(Sender: TObject);
begin
  FXMLOption:=TXMLOption.Create;
end;
procedureTForm1.FormDestroy(Sender: TObject);
begin
  FXMLOption.Free;
end;
procedureTForm1.Button1Click(Sender: TObject);
begin
  FXMLOption.CreateBlank(edit1.Text);
end;
procedureTForm1.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;
procedureTForm1.Button3Click(Sender: TObject);
begin
  FXMLOption.OpenXml(edit1.Text);
  WebBrowser1.Navigate(ExtractFilePath(application.ExeName)+edit1.Text);
end;
procedureTForm1.Button4Click(Sender: TObject);
begin
  FXMLOption.CloseXml;
  WebBrowser1.Navigate('about:blank');
end;
procedureTForm1.Button5Click(Sender: TObject);
begin
  if  FXMLOption.FindUser(edit2.text) then label1.Caption:='true'
  else label1.Caption:='false';
end;
procedureTForm1.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;
procedureTForm1.Button7Click(Sender: TObject);
begin
  FXMLOption.RemoveUser(edit2.text);
  WebBrowser1.Navigate(ExtractFilePath(application.ExeName)+edit1.Text);
end;
procedureTForm1.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：
objectForm1: 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
  objectLabel1: TLabel
    Left = 440
    Top = 400
    Width = 32
    Height = 13
    Caption = 'Label1'
  end
  objectButton1: TButton
    Left = 256
    Top = 360
    Width = 75
    Height = 25
    Caption = 'CreateBlank'
    TabOrder = 0
    OnClick =Button1Click
  end
  objectButton2: TButton
    Left = 352
    Top = 360
    Width = 75
    Height = 25
    Caption = 'AddUser'
    TabOrder = 1
    OnClick =Button2Click
  end
  objectEdit1: TEdit
    Left = 208
    Top = 328
    Width = 121
    Height = 21
    TabOrder = 2
    Text = 'userxml.xml'
  end
  objectEdit2: TEdit
    Left = 352
    Top = 328
    Width = 121
    Height = 21
    TabOrder = 3
    Text = '900'
  end
  objectButton3: TButton
    Left = 256
    Top = 384
    Width = 75
    Height = 25
    Caption = 'OpenXml'
    TabOrder = 4
    OnClick =Button3Click
  end
  objectButton4: TButton
    Left = 256
    Top = 408
    Width = 75
    Height = 25
    Caption = 'CloseXml'
    TabOrder = 5
    OnClick =Button4Click
  end
  objectButton5: TButton
    Left = 352
    Top = 392
    Width = 75
    Height = 25
    Caption = 'FindUser'
    TabOrder = 6
    OnClick =Button5Click
  end
  objectWebBrowser1: TWebBrowser
    Left = 0
    Top = 0
    Width = 688
    Height = 313
    Align =alTop
    TabOrder = 7
    ControlData = {
      4C0000001B470000592000000000000000000000000000000000000000000000
      000000004C000000000000000000000001000000E0D057007335CF11AE690800
      2B2E126208000000000000004C0000000114020000000000C000000000000046
      8000000000000000000000000000000000000000000000000000000000000000
      00000000000000000100000000000000000000000000000000000000}
  end
  objectButton6: TButton
    Left = 432
    Top = 360
    Width = 75
    Height = 25
    Caption = 'InsertUser'
    TabOrder = 8
    OnClick =Button6Click
  end
  objectButton7: TButton
    Left = 512
    Top = 360
    Width = 75
    Height = 25
    Caption = 'RemoveUser'
    TabOrder = 9
    OnClick =Button7Click
  end
  objectButton8: TButton
    Left = 512
    Top = 392
    Width = 75
    Height = 25
    Caption = 'ReplaceUser'
    TabOrder = 10
    OnClick =Button8Click
  end
end

http://blog.csdn.net/genispan/article/details/4364492

以上XPATH有误 应改为：
xpath:=UsersTag '[@' U_Id '=&quot;' userid '&quot;]';

标签：#xpath#xml语言#delphi#string | 浏览：274 | 发布日期：

免责声明：文章转载自《delphi 操作xml示例（DelphiBBS）》仅用于学习参考。如对内容有疑问，请及时联系本站处理。

上篇vue--渲染后修改数据不刷新数量线程SM,SP和GRID,BLOCK,THREAD之间的对应关系是什么？下篇

宿迁高防，2C2G15M，22元/月；香港BGP，2C5G5M，25元/月 雨云优惠码：MjYwNzM=

相关文章

string替换所有指定字符串（C++）

C++的string提供了replace方法来实现字符串的替换，但是对于将字符串中某个字符串全部替换这个功能，string并没有实现，我们今天来做的就是这件事。 首先明白一个概念，即string替换所有字符串，将"12212"这个字符串的所有"12"都替换成"21"，结果是什么？ 可以是22211，也可以是21221，有时候应用的场景不同，就会希望得到不同...

Stream的流处理--主要用于的是条件的筛选

用优雅的方式写出ArrayList 中的值得条件筛选 主要用到的java8中lambda的表达式 1 public class BaseDemo { 2 public static void main(String[] args) { 3 // 用Stream的方式来筛选list中的值 4 ArrayList...

三步轻松打造微信聊天机器人（附源码）

    最近微信公众平台开发是热门，我也跟风做了一个陪聊的公众号。       其实类似的自动回话程序早就有了，比如前一阵很火的小黄鸡（还是小黄鸭来着？）。但尽管是跟风，也要体现一些不同。别人做的都是中文陪聊，咱就来做个英语陪聊。       不管是中文还是英文，做起来都一样，都是利用网络上的接口。或者你也可以试着自己开发一个陪聊程序。       随便在...

java FastJSON的使用

1.JSON介绍 JSON(javaScript Object Notation)是一种轻量级的数据交换格式。主要采用键值对({"name": "json"})的方式来保存和表示数据。JSON是JS对象的字符串表示法，它使用文本表示一个JS对象的信息，本质上是一个字符串。 2.FastJson简介 fastjson是阿里巴巴的开源JSON解析库，它可以解析...

Tomcat的配置文件详解

前提， Tomcat *的下载（绿色版和安装版都适用）Tomcat *的安装和运行（绿色版和安装版都适用）　　Tomcat的配置文件，在$TOMCAT_HOME下的conf，我这里是， 1、打开server.xml 　　我们可以在server.xml文件中修改端口号，找到conf文件夹，打开其中的server.xml， 目前设置的端口号是8080：...

Java: JavaMail 初试(一)

前言：以前的我，很喜欢写东西，写一写所想所见所闻所感，但是工作之后，总不能写出让自己满意的文章，突发奇想，能否利用写博客的时机，将其写成类似散文似的博文呢？哈哈... 邮件功能尝试：作为一个小菜鸟，对于技术性的东西却有特殊的偏好，每每通过自己学习而获得新的知识，总会如孩童拥有一个新奇的玩意儿一样，欢欣雀跃。第一次写邮件功能，这一篇文章就是记录下，我在参考网...

最新文章

随机推荐

思享工具箱导航