领购物优惠券9块9包邮
首页 > 编程语言 > 其他教程 > delphi文章/教程

delphi 操作xml示例（DelphiBBS）

   2023-02-09 学习力0
核心提示：自：http://www.delphibbs.com/keylife/iblog_show.asp?xid=20713================================================================2005-9-23 21:05:34xml基础操作实例，因为刚开始学，如果有不对的地方，请批评指正，代码如下：unit XMLOptionUnit;//=====
自：http://www.delphibbs.com/keylife/iblog_show.asp?xid=20713
================================================================
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

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

 

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

 

 
反对 0举报 0 评论 0
 

免责声明：本文仅代表作者个人观点，与乐学笔记（本网）无关。其原创性以及文中陈述文字和内容未经本站证实，对本文以及其中全部或者部分内容、文字的真实性、完整性、及时性本站不作任何保证或承诺，请读者仅作参考，并请自行核实相关内容。
    本网站有部分内容均转载自其它媒体，转载目的在于传递更多信息，并不代表本网赞同其观点和对其真实性负责，若因作品内容、知识产权、版权和其他问题，请及时提供相关证明等材料并与我们留言联系，本网站将在规定时间内给予删除等相关处理.

  • Delphi中的消息处理机制 delphi 方法
    每一个VCL都有一内在的消息处理机制，其基本点就是构件类接收到某些消息并把它们发送给适当的处理方法,如果没有特定的处理方法，则调用缺省的消息处理句柄。    其中mainwndproc是定义在Twincontrol类中的一个静态方法，不能被重载(Override)。它不直接处
    02-09
  • Delphi XE6 通过JavaScript API调用百度地图
    Delphi XE6 通过JavaScript API调用百度地图
    参考昨天的内容，有朋友还是问如何调用百度地图，也是，谁让咱都在国内呢，没办法，你懂的。 首先去申请个Key，然后看一下百度JavaScript的第一个例子:http://developer.baidu.com/map/jsdemo.htm下一步，就是把例子中的代码，移动TWebBrower中。 unit Unit
    02-09
  • Delphi编译/链接过程 delphi编程案例
    Delphi编译/链接过程 delphi编程案例
    下面展示了Delphi是怎样编译源文件，并且把它们链接起来，最终形成可执行文件。当Delphi编译项目（Project）时，将编译项目源文件、窗体单元和其他相关单元，在这个过程中将会发生好几件事情：首先，Object Pascal编译器把项目单元编译为二进制对象文件，然后
    02-09
  • Delphi CompilerVersion Constant / Compiler C
    http://delphi.wikia.com/wiki/CompilerVersion_Constant The CompilerVersion constant identifies the internal version number of the Delphi compiler.It is defined in the System unit and may be referenced either in code just as any other consta
    02-09
  • Delphi revelations #1 – kbmMW Smart client
    Delphi 启示 #1 – kbmMW Smart client on NextGen (Android) – 作用域问题以更高级的方式使用kbmMW smart client,在Android设备上，我遇到了问题。通过继承TInvokeableVariantType，kbmMW smart client可以使用Delphi支持的特殊类型的自定义Variant，从而可
    02-09
  • Delphi 调用DLL外部函数时的指针参数
    某项目需要调用设备厂家提供的DLL的函数，厂家给了一个VB的例子，有个参数是ByRef pBuffer As Single。于是在Delphi中用buffer:array of single代替：function func(buffer:array of single;count:integer):integer;far;stdcall;external 'func.dll';调用后bu
    02-09
  • 《zw版·Halcon-delphi系列原创教程》 Halcon分
    《zw版·Halcon-delphi系列原创教程》 Halcon分类函数012,polygon，多边形为方便阅读，在不影响说明的前提下，笔者对函数进行了简化：:: 用符号“**”，替换：“procedure”:: 用大写字母“X”，替换：“IHUntypedObjectX”:: 省略了字符：“const”、“OleVa
    02-09
  • 最简单的delphi启动画面（转）
    首先做一窗体，然后将BorderStyle的属性设为bsnone,放image控件，align设为alclient 然后将主程序的修改为 uses Windows, Forms, Unit1 in 'Unit1.pas' {Form1}, Unit2 in 'Unit2.pas' {Form2}; {$ R *.res} begin Application.Initialize; Form2:=TForm2.Cre
    02-09
  • Delphi备忘三：TCollection的使用，用Stream保
     代码unit ufrmGetFunctionDefine;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,TypInfo,  Dialogs,ufrmStockBaseCalc, StdCtrls, ComCtrls,uQEFuncManager,uWnDataSet,uDataService;type  T
    02-09
  • Delphi Dcp 和BPL的解释
    dcp = delphi compiled package，是 package 编译时跟 bpl 一起产生出来的，记录着 package 中公开的 class、procedure、function、variable、const.... 等等的名称和相对位址。package英文翻译过来就是“包”。如果 某个控件包 A 引用了 控件包 B，当 控件包
    02-09
更多>PHP教程
php-fpm进程管理的三种模式 phpfpm子进程 [PHP8] 我参加了PHP8工程师认证初学者考试beta考试
更多>C/C++教程
VScode运行C++中文终端乱码的解决方案 vscode错误提示中文 C++ LeetCode1945题解字符串转化后的各位数字之和
更多>Java教程
Java项目导出数据为 PDF 文件的操作代码 盘点Java中延时任务的多种实现方式 java 延时队列怎么实现
更多>ASP.NET
使用WebClient自动填写并提交ASP.NET页面表单的源代码 asp.net mvc多条件+分页查询解决方案 asp.net mvc多条件+分页查询解决方案
更多>JSP编程
JSP通用高大上分页代码(超管用) JSP验证码动态生成方法
点击排行
网站首页  |  关于我们  |  联系方式  |  使用协议  |  版权隐私  |  网站地图  |  网站留言  |  违规举报