delphi 操作xml示例（DelphiBBS）

自：http://www.delphibbs.com/keylife/iblog_show.asp?xid=20713

================================================================

-- ::    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文档操作用户实例'# +

                    '用户结构为序号，姓名，性别，出生年月日，电话，住址，邮编，电邮'# +

                    '作者 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:='';

  auser.U_Addr:='tom 大街 8 号';

  auser.U_PostCode:='';

  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:='';

  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:='';

  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 =

  Top =

  Width =

  Height =

  Caption = 'Form1'

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -

  Font.Name = 'MS Sans Serif'

  Font.Style = []

  OldCreateOrder = False

  OnCreate = FormCreate

  OnDestroy = FormDestroy

  PixelsPerInch =

  TextHeight =

  object Label1: TLabel

    Left =

    Top =

    Width =

    Height =

    Caption = 'Label1'

  end

  object Button1: TButton

    Left =

    Top =

    Width =

    Height =

    Caption = 'CreateBlank'

    TabOrder =

    OnClick = Button1Click

  end

  object Button2: TButton

    Left =

    Top =

    Width =

    Height =

    Caption = 'AddUser'

    TabOrder =

    OnClick = Button2Click

  end

  object Edit1: TEdit

    Left =

    Top =

    Width =

    Height =

    TabOrder =

    Text = 'userxml.xml'

  end

  object Edit2: TEdit

    Left =

    Top =

    Width =

    Height =

    TabOrder =

    Text = ''

  end

  object Button3: TButton

    Left =

    Top =

    Width =

    Height =

    Caption = 'OpenXml'

    TabOrder =

    OnClick = Button3Click

  end

  object Button4: TButton

    Left =

    Top =

    Width =

    Height =

    Caption = 'CloseXml'

    TabOrder =

    OnClick = Button4Click

  end

  object Button5: TButton

    Left =

    Top =

    Width =

    Height =

    Caption = 'FindUser'

    TabOrder =

    OnClick = Button5Click

  end

  object WebBrowser1: TWebBrowser

    Left =

    Top =

    Width =

    Height =

    Align = alTop

    TabOrder =

    ControlData = {

      4C0000001B470000592000000000000000000000000000000000000000000000

      000000004C000000000000000000000001000000E0D057007335CF11AE690800

      2B2E126208000000000000004C0000000114020000000000C000000000000046

      8000000000000000000000000000000000000000000000000000000000000000

      00000000000000000100000000000000000000000000000000000000}

  end

  object Button6: TButton

    Left =

    Top =

    Width =

    Height =

    Caption = 'InsertUser'

    TabOrder =

    OnClick = Button6Click

  end

  object Button7: TButton

    Left =

    Top =

    Width =

    Height =

    Caption = 'RemoveUser'

    TabOrder =

    OnClick = Button7Click

  end

  object Button8: TButton

    Left =

    Top =

    Width =

    Height =

    Caption = 'ReplaceUser'

    TabOrder =

    OnClick = Button8Click

  end

end

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

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

delphi 操作xml示例（DelphiBBS）的更多相关文章

Delphi操作XML
Delphi操作XML Delphi操作XMl,只要使用 NativeXml.我是用的版本是4..NativeXML的使用方法比较简单,但是功能很强大. XE2的话,要在simdesign.inc后面 ...
Delphi操作XML - 冰雪傲骨
Delphi操作XMl,只要使用 NativeXml.我是用的版本是4..NativeXML的使用方法比较简单,但是功能很强大. XE2的话,要在simdesign.inc后面加上: // Delph ...
delphi操作xml学习笔记之一入门必读
Delphi 对XML的支持---TXMLDocument类 Delphi7 支持对XML文档的操作,可以通过TXMLDocument类来实现对XML文档的读写.可以利用TXMLDocum ...
Delphi操作XML简介
参考:http://www.delphifans.com/InfoView/Article_850.html Delphi 7支持对XML文档的操作,可以通过 TXMLDocument类来实现对XML ...
Delphi操作XML的几个博客
http://www.cnblogs.com/acuier 整整十几篇,省得我自己研究,学一下就可以了. http://www.cnblogs.com/del/category/113561.htm ...
Delphi ServerSocket,ClientSocket示例
Delphi ServerSocket,ClientSocket示例 2008-05-09 16:20 Delphi TServerSocket,TClientSocket实现传送文件代码 1.建立两 ...
操作xml文档的常用方式
1.操作XML文档的两种常用方式: 1)使用XmlReader类和XmlWriter类操作 XmlReader是基于数据流的,占用极少的内存,是只读方式的,所以速度极快.只能采用遍历的模式查找数据节点 ...
Java原生API操作XML
使用Java操作XML的开源框架比较多,如著名的Dom4J.JDOM等,但个人认为不管你用那个框架都要对JDK原生的API有所了解才能更得心应手的应用.本篇就来简单了解下原生的XML API. JAV ...
PHP原生DOM对象操作XML'代码'
对于操作XML类型文件,PHP内置有一套DOM对象可以进行处理.对XML的操作,从创建.添加到修改.删除都可以使用DOM对象中的函数来进行. 创建创建一个新的XML文件,并且写入一些数据到这个XML ...

随机推荐

RandomStringUtils RandomUtils
上一篇是StringUtils 链接http://www.cnblogs.com/tele-share/p/8060129.html 1.RandomStringUtils 1.1模拟实现random ...
全栈JavaScript之路（二十五）訪问元素的样式
不论什么支持style 特性的元素在 ,在其DOM 节点对象中都有一个 style 属性与之相应. 这个style 对象是 CSSStyleDeclaration类型的实例,包括着html sty ...
删除vector中的重复数据(unique)
#include <iostream> #include <vector> #include <algorithm> #include <assert.h&g ...
Gibbs 采样的应用
Gibbs 采样的最大作用在于使得对高维连续概率分布的抽样由复杂变得简单. 可能的应用: 计算高维连续概率分布函数的数学期望, Gibbs 采样得到 n 个值,再取均值: 比如用于 RBM:
php课程 6-24 字符串函数有哪些（复习）
php课程 6-24 字符串函数有哪些(复习) 一.总结一句话总结: 二.php课程 6-24 字符串函数有哪些(复习) 上次复习:--------------------------------- ...
【网络】无法解析服务器的DNS地址？；能登陆QQ，无法打开网页
1. 无法解析服务器的DNS地址手动设置 DNS(域名解析服务器) 8.8.8.8 114.114.114.114 清除浏览器缓存: 重启主机: 无法解析服务器的DNS地址?DNS解析错误怎么办? ...
HDU 1502 - dp + 压位
传送门题目大意: 3*n的字符串,A.B.C分别有n个,w(X)代表X字母出现的次数,要求该字符串的所有前缀中w(A) >= w(B) >= w(C),问合法方案数有多少. 题目分析: ...
【BZOJ 1014】 [JSOI2008]火星人prefix
[题目链接]:http://www.lydsy.com/JudgeOnline/problem.php?id=1014 [题意] 让你在线查询最长公共前缀. 支持单节点修改; 插入操作; [题解] / ...
C++动态数组简单的模拟二元堆
//C++动态数组简单的模拟二元堆 #include<iostream> using namespace std; class BinaryHeap { private: int cap; ...
Crystal Report - 利用后台代码设计或实现水晶报表工具栏相关功能
水晶报表工具栏分页按钮响应事件: 水晶报表中有自带的分页功能,在设置好每页显示的记录后会自动分页,并自动记录总页数和保存当前页,在工具栏可以通过“首页”“尾页”“下一页”“上一页”和“跳页”进行页面跳 ...

delphi 操作xml示例（DelphiBBS）

delphi 操作xml示例（DelphiBBS）的更多相关文章

随机推荐

热门专题