Delphi Xml

用递归方法，使用 xml 文档生成 Treeview 树形视图。由于是动态生成，所以可以通过修改 xml 的逻辑来定制 Treeview 的结构，
从而实现了 xml 对 Treeview 的动态配置，而不用修改代码。

xml 文件如下：

<?xml version="1.0" encoding="gb2312"?>
<root topic="频道列表" catalog="none">

<channel topic="操作系统" catalog="none">
<channel topic="Windows频道" catalog="windows" />
<channel topic="DOS频道" catalog="dos" />
<channel topic="Linux" catalog="linux" />
</channel>

<channel topic="菜鸟专区" catalog="cainiaozhuanqu" />

<channel topic="应用软件" catalog="app" />

<channel topic="安全专区" catalog="safe" />

<channel topic="代码实验室" catalog="lab" />

<BBS topic="电脑学习社区" catalog="none">
<subBBS topic="子社区-" catalog="sub1" />
<subBBS topic="子社区-" catalog="sub2" />
</BBS>

</root>

程序代码如下：

unit tree_xml;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms, Dialogs, ComCtrls, StdCtrls, XMLDoc, XMLIntf;

type
TForm1 = class(TForm)
TreeView1: TTreeView;
Memo1: TMemo;
Button1: TButton;
procedure TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1Click(Sender: TObject);
private
function CreateTreeview(XmlNode: IXMLNode; TreeNode: TTreeNode):TTreeNode;
{ Private declarations }
public
{ Public declarations }
end;

type
pRec = ^TData;
TData = record
sCatalog: string;
sReserved: String
end;

var
Form1: TForm1;

implementation
{$R *.dfm}

function TForm1.CreateTreeview(XmlNode: IXMLNode; TreeNode: TTreeNode): TTreeNode;
var
i: integer;
ParentTreeNode, CurrentTreeNode: TTreeNode;
pData: pRec;
begin
New(pData);
pData^.sCatalog := XmlNode.AttributeNodes['catalog'].NodeValue;
CurrentTreeNode := TreeView1.Items.AddChildObject(TreeNode,
XmlNode.AttributeNodes['topic'].NodeValue, pData); //pointer(...)
if XmlNode.HasChildNodes then
begin
ParentTreeNode := CurrentTreeNode;
for i:= to XmlNode.ChildNodes.Count- do
begin
CreateTreeview(XmlNode.ChildNodes[i], ParentTreeNode);
end;
end;
result := CurrentTreeNode;
end;

{------------------------------------------------------------------}
procedure TForm1.TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var pData: pRec;
begin
pData := Treeview1.Selected.Data;
Memo1.Lines.Add(pData^.sCatalog);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
oXml: TXMLDocument;
begin
oXml := TXMLDocument.Create(self);
oXml.FileName := '_Treeview.xml';
oXml.Active:=true;
CreateTreeview(oXml.ChildNodes.FindNode('root'), Treeview1.Items.GetFirstNode);
Treeview1.FullExpand; //节点全部展开
oXml.Free;
end;

end.

注意程序中 Treeview 的 TreeView1.Items.AddChildObject 方法，其最后一个参数用来保存该节点的相关数据，是一个指针类型的数据，使用时要格外小心。本例中，先定义一个记录类型，再定义一个指针指向它，然后作为 AddChildObject 的最后一个参数。记录类型可以保存节点的很多相关参数，本例中只用到了一个，实际使用时可以任意扩充。

使用delphi来操作xml文件，或者xml字符串,
导入需要单元，XMLDoc，XMLIntf这两个库文件。
doc : TXMLDocument;
rootnode : IXMLNode;
chender : IXMLNodeList

TXMLDocument是文档结构，IXMLNode是文档节点，
IXMLNodeList是节点集合。

doc:=TXMLDocument.Create(nil);
doc.Active:=True;
doc.LoadFromXML(Trim(rectext));
rootnode:=doc.DocumentElement;
chender:=rootnode.ChildNodes;

创建文档模型以及根基点与子节点集合。

//mmoRecod.Lines.Add(rootnode.Text);
SetLength(files,chender.Count);
for I :=  to chender.Count- do
begin
mmoRecod.Lines.Add(chender[i].Attributes['name']);
filetemp:=FileObj.Create;
filetemp.name:= chender[i].Attributes['name'];
filetemp.filepath:= chender[i].Attributes['path'];
filetemp.filetype:= chender[i].Attributes['type'];
filetemp.localpath:= chender[i].Attributes['localpath'];
files[i]:=filetemp;
end;

上面是对节点相关的操作，基本上与DOM操作一致，方便简单。
Delphi操作XML

Delphi操作XML是很方便的，主要有两种方法；
1.用TClientDataSet操作XML；TClientDataSet是个好东西，用它操作XML是很简单的事，不过缺点是只能操作固定格式的 XML，它适合操作表结构的数据，如果你需要把数据表导出成XML那用TClientDataSet是个好主意，比如下面是一个数据集导出成XML的方 法：

procedure ExportToXML(SrcDataSet:TDataSet;const XMLFileName:String);
var tmpCds:TClientDataSet;
i:integer;
NewField:TFieldDef;
begin
SrcDataSet.DisableControls;
tmpCds:=TClientDataSet.Create(nil);
try
for i:= to SrcDataSet.FieldCount- do
begin
NewField:=tmpCds.FieldDefs.AddFieldDef;
NewField.Name:=SrcDataSet.Fields[i].FieldName;
NewField.DataType:=SrcDataSet.fields[i].DataType;
NewField.Size:=SrcDataSet.Fields[i].Size;
end;
tmpCds.CreateDataSet;
if tmpCds.Active then tmpCds.LogChanges:=False;

SrcDataSet.First;
while not SrcDataSet.Eof do
begin
tmpCds.Append;
for i:= to SrcDataSet.FieldCount- do
tmpCds.FieldByName(SrcDataSet.Fields[i].FieldName).Value:=SrcDataSet.Fields[i].Value;
tmpCds.Post;

SrcDataSet.Next;
end;
tmpCds.SaveToFile(XMLFileName);
finally
SrcDataSet.EnableControls;
tmpCds.Free;
end;
end;

2.还有一种方法就是用TXMLDocument了，TXMLDocument很灵活，因此操作起来有点麻烦，特别是XML树很深的时候。不过 Delphi给我们提供了更方便的方法，使我们更加简单的操作XML，这个方法就是XML Data Binding向导，XML Data Binding向导会把XML的节点映射成对象，从而使我们更方便的操作它们。下面是一个XML Data Binding使用的例子。

比如我有一个叫Config.xml的配置文件，内容如下：

<?xml version="1.0" encoding="UTF-"?>
<Config>
<ProductName></ProductName>
<DB>
<Connection Host="" DbName="" UserName="" PassWord=""/>
</DB>
</Config>

以Delphi7为例，点new->Other->XML Data Binding，然后出现XML Data Binding向导对话框，选择自己的XML文件，点"Next"....，完成后就会生成一个代码单元，比如上面的XML就会生成这样的代码：

{***************************************}
{ }
{ XML Data Binding }
{ }
{ Generated on: 2009-7-26 1:31:14 }
{ Generated from: D:/Config.xml }
{ }
{***************************************}

unit Config;

interface

uses xmldom, XMLDoc, XMLIntf;

type

{ Forward Decls }

IXMLConfigType = interface;
IXMLDBType = interface;
IXMLConnectionType = interface;

{ IXMLConfigType }

IXMLConfigType = interface(IXMLNode)
['{F78E0752-5D0C-4350-A59C-7743CB844322}']
{ Property Accessors }
function Get_ProductName: WideString;
function Get_DB: IXMLDBType;
procedure Set_ProductName(Value: WideString);
{ Methods & Properties }
property ProductName: WideString read Get_ProductName write Set_ProductName;
property DB: IXMLDBType read Get_DB;
end;

{ IXMLDBType }

IXMLDBType = interface(IXMLNode)
['{1CB67B0A-92B4-4B50-AB64-167605EA6789}']
{ Property Accessors }
function Get_Connection: IXMLConnectionType;
{ Methods & Properties }
property Connection: IXMLConnectionType read Get_Connection;
end;

{ IXMLConnectionType }

IXMLConnectionType = interface(IXMLNode)
['{6976B41B-28C5-407F-8D19-B6B6E153265F}']
{ Property Accessors }
function Get_Host: WideString;
function Get_DbName: WideString;
function Get_UserName: WideString;
function Get_PassWord: WideString;
procedure Set_Host(Value: WideString);
procedure Set_DbName(Value: WideString);
procedure Set_UserName(Value: WideString);
procedure Set_PassWord(Value: WideString);
{ Methods & Properties }
property Host: WideString read Get_Host write Set_Host;
property DbName: WideString read Get_DbName write Set_DbName;
property UserName: WideString read Get_UserName write Set_UserName;
property PassWord: WideString read Get_PassWord write Set_PassWord;
end;

{ Forward Decls }

TXMLConfigType = class;
TXMLDBType = class;
TXMLConnectionType = class;

{ TXMLConfigType }

TXMLConfigType = class(TXMLNode, IXMLConfigType)
protected
{ IXMLConfigType }
function Get_ProductName: WideString;
function Get_DB: IXMLDBType;
procedure Set_ProductName(Value: WideString);
public
procedure AfterConstruction; override;
end;

{ TXMLDBType }

TXMLDBType = class(TXMLNode, IXMLDBType)
protected
{ IXMLDBType }
function Get_Connection: IXMLConnectionType;
public
procedure AfterConstruction; override;
end;

{ TXMLConnectionType }

TXMLConnectionType = class(TXMLNode, IXMLConnectionType)
protected
{ IXMLConnectionType }
function Get_Host: WideString;
function Get_DbName: WideString;
function Get_UserName: WideString;
function Get_PassWord: WideString;
procedure Set_Host(Value: WideString);
procedure Set_DbName(Value: WideString);
procedure Set_UserName(Value: WideString);
procedure Set_PassWord(Value: WideString);
end;

{ Global Functions }

function GetConfig(Doc: IXMLDocument): IXMLConfigType;
function LoadConfig(const FileName: WideString): IXMLConfigType;
function NewConfig: IXMLConfigType;

const
TargetNamespace = '';

implementation

{ Global Functions }

function GetConfig(Doc: IXMLDocument): IXMLConfigType;
begin
Result := Doc.GetDocBinding('Config', TXMLConfigType, TargetNamespace) as IXMLConfigType;
end;

function LoadConfig(const FileName: WideString): IXMLConfigType;
begin
Result := LoadXMLDocument(FileName).GetDocBinding('Config', TXMLConfigType, TargetNamespace) as IXMLConfigType;
end;

function NewConfig: IXMLConfigType;
begin
Result := NewXMLDocument.GetDocBinding('Config', TXMLConfigType, TargetNamespace) as IXMLConfigType;
end;

{ TXMLConfigType }

procedure TXMLConfigType.AfterConstruction;
begin
RegisterChildNode('DB', TXMLDBType);
inherited;
end;

function TXMLConfigType.Get_ProductName: WideString;
begin
Result := ChildNodes['ProductName'].Text;
end;

procedure TXMLConfigType.Set_ProductName(Value: WideString);
begin
ChildNodes['ProductName'].NodeValue := Value;
end;

function TXMLConfigType.Get_DB: IXMLDBType;
begin
Result := ChildNodes['DB'] as IXMLDBType;
end;

{ TXMLDBType }

procedure TXMLDBType.AfterConstruction;
begin
RegisterChildNode('Connection', TXMLConnectionType);
inherited;
end;

function TXMLDBType.Get_Connection: IXMLConnectionType;
begin
Result := ChildNodes['Connection'] as IXMLConnectionType;
end;

{ TXMLConnectionType }

function TXMLConnectionType.Get_Host: WideString;
begin
Result := AttributeNodes['Host'].Text;
end;

procedure TXMLConnectionType.Set_Host(Value: WideString);
begin
SetAttribute('Host', Value);
end;

function TXMLConnectionType.Get_DbName: WideString;
begin
Result := AttributeNodes['DbName'].Text;
end;

procedure TXMLConnectionType.Set_DbName(Value: WideString);
begin
SetAttribute('DbName', Value);
end;

function TXMLConnectionType.Get_UserName: WideString;
begin
Result := AttributeNodes['UserName'].Text;
end;

procedure TXMLConnectionType.Set_UserName(Value: WideString);
begin
SetAttribute('UserName', Value);
end;

function TXMLConnectionType.Get_PassWord: WideString;
begin
Result := AttributeNodes['PassWord'].Text;
end;

procedure TXMLConnectionType.Set_PassWord(Value: WideString);
begin
SetAttribute('PassWord', Value);
end;

end.

这个单元会生成三个GetXXX,LoadXXX,NewXXX的函数,用这几个函数就可以操作我们的XML了。例如：

uses XMLDoc,XMLIntf,Config;//Config是我上面XML Data Binding 生成的单元

var Config:IXMLConfigType;
XMLDoc:IXMLDocument;
XMLFileName:String;
begin
XMLFileName:=ExtractFilePath(ParamStr())+'Config.xml';
if FileExists(XMLFileName) then
XMLDoc:=LoadXMLDocument(XMLFileName)
else begin
XMLDoc:=NewXMLDocument;
XMLDoc.Encoding:='UTF-8';
end;
Config:=GetConfig(XMLDoc);
//写
Config.ProductName:='软件名称';
Config.DB.Connection.Host:='127.0.0.1';
Config.DB.Connection.DbName:='test';
Config.DB.Connection.UserName:='sa';
Config.DB.Connection.PassWord:='';
//读
showmessage(Config.ProductName);

XMLDoc.SaveToFile(XMLFileName);
end;

xml

unit wfp;

interface
     uses Classes,Dialogs,SysUtils,Uni,ComCtrls, DB,UniProvider, SQLiteUniProvider,XMLDoc;
     {}
function NewDbFile(DBfile:string;UniConnection:TUniConnection):boolean;
Function OpenDbFile(DBfile:string;tree:TTreeView;UniConnection:TUniConnection):boolean;
{}
implementation
    uses index,Unit1;
    {}
function NewDbFile(DBfile:string;UniConnection:TUniConnection):boolean;
var
ID:integer;
del:boolean;
Query:TUniQuery;
begin
try
    try
    if  FileExists(DBfile) then
    begin
    //需要进行占用分析
    del:=DeleteFile(DBfile); //如果存在就删除 ,有可能删除失败
    end;
    ID := filecreate(DBfile);
    FileClose(ID);
    // 创建基础表
    if UniConnection.connected = true then
    begin
      UniConnection.connected := false;
    end;
    UniConnection.ProviderName := 'Sqlite';
    UniConnection.SpecificOptions.Values['ClientLibrary'] := 'sqlite3.dll';
    UniConnection.database := DBfile;
    UniConnection.connected := true;
    // UniTransaction1.Connections[0].StartTransaction;
    query:=TUniQuery.Create(nil);
    query.Connection:=uniConnection;
    with  Query do
    begin
     close;
     SQL.Clear;
     SQL.Add('PRAGMA auto_vacuum = 1');//启动数据库压缩
     Execute();

    SQL.Clear;
    SQL.Add( 'create table File_list(id text,Type_id text,F_name text,Ex_name text,Path_name text,F_size text,C_time text,X_time,F_time text,F_Con BLOB )');
    Execute();
 //附件表
    SQL.Clear;
    SQL.Add('create table type_tree(id integer primary key,Status integer,tree Blob)');
    Execute();
 //文本内容表
    SQL.Clear;
    SQL.Add('create table Rich(Type_id text,c_time text,F_Con Blob)');
    Execute();

    SQL.Clear;
    SQL.Add('insert into type_tree(id) values(0)');
    Execute();
    end;
      result:=true;
    //UniTransaction1.Connections[0].Commit;//提交事务
      except on e: Exception do
      begin
       result:=false;
       end;
      end;
    finally
      Query.Close;
      Query.Free;
    end;

end;

Function OpenDbFile(DBfile:string;tree:TTreeView;UniConnection:TUniConnection):boolean;
{ 打开数据库 }
var
 // T: DWORD;
  query: TUniQuery;
  XMLDocument1: TXMLDocument;
  temp:string;
  mstream:TMemoryStream;
begin
   MainFrm_U.StatusBar1.Panels[].Text := '数据库' + DBfile;
    if UniConnection.connected = true then
    begin
      UniConnection.connected := false;
    end;
    UniConnection.ProviderName := 'Sqlite';
    UniConnection.SpecificOptions.Values['ClientLibrary'] := 'sqlite3.dll';
    UniConnection.database := DBfile;
    UniConnection.connected := true;
    MainFrm_U.StatusBar1.Panels[].Text := '正在载入导航信息...';
    // 载入用户表
    // T := GetTickCount;
    //查询数据库,导出xml，tree加载xml
    query:=TUniQuery.Create(nil);
    query.Connection:=uniConnection;
    query.SQL.Text :='select tree From Type_Tree WHERE id = 0' ;
    query.Open;
    try
      if query.RecordCount> then
      begin
      temp:=ExtractFilePath(DBfile)+ChangeFileExt(ExtractFileName(DBfile),'') +'.~tmp';
      //temp:=ChangeFileExt(ExtractFilePath(DBfile),'~tmp') ;
      while not query.Eof do
      begin
        // if query.FieldByName('tree')<> nil then
        if not query.FieldByName('tree').IsNull then
         begin
         //TBlobField(query.FieldByName('tree')).SaveToFile(temp);
         mstream:=TMemoryStream.Create;
         TBlobField(query.FieldByName('tree')).SaveToStream(mstream);//保存进流
         //XMLDocument1:=TXMLDocument.Create(nil);
         XMLDocument1:=MainFrm_U.XMLDocument1;//TXMLDocument.Create(nil);
         //XMLDocument1.FileName:= temp;
         XMLDocument1.LoadFromStream(mstream);
         XML2TreeStream(tree,XMLDocument1,mstream);
         //XML2Tree(tree,XMLDocument1,temp);
         //showmessage(temp);
         //if  FileExists(temp) then
         //DeleteFile(temp);
         //end
        // else
        // begin
        // Exit;
         end;
        query.next;

      end;

    end;
   except on e: Exception do
      begin
      MainFrm_U.StatusBar1.Panels[].Text :='打开数据库时发生错误';
      query.Free;
      end;
    end;

end;
end.

从XML文件读取

procedure TMainFrm_U.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
var
  query: TUniQuery;
  des:TMemoryStream;
begin
//if  Length(UniConnection1.Database)>0 then
if UniConnection1.Connected then
begin
try
  //Tree2XML(treeview1,ChangeFileExt(ExtractFilePath(UniConnection1.Database),'.~tmp'));//相当于创建更新数据 ChangeFileExt(ExtractFilePath(UniConnection1.Database),'.~tmp')
  des:=TMemoryStream.Create;
  Tree2XMLStream(treeview1,des);
  query:=TUniQuery.Create(nil);
  query.Connection:=uniConnection1;
  query.SQL.Text :='UPDATE Type_Tree SET tree = :F_Con WHERE id = 0' ;
  //query.ParamByName('F_Con').LoadFromFile(ChangeFileExt(ExtractFilePath(UniConnection1.Database),'.~tmp'), DB.ftBlob);  //ExtractFilePath(UniConnection1.Database)+'\'+'~'+ChangeFileExt(ExtractFileName(UniConnection1.Database),'')+'.tmp'

  query.ParamByName('F_Con').LoadFromStream(des,DB.ftBlob);
  query.Execute;
  //DeleteFile(ChangeFileExt(ExtractFilePath(UniConnection1.Database),'.~tmp'));
   except on e: Exception do
      begin
      showmessage('失败');
      query.Free;
      end;
    end;
end;
end;

用Delphi快速生成XML

HTML(超文本标记语言)是编制网页的基本语言，但它只能用于静态的网页。当今的Web已经不再是早期的静态信息发布平台，它已被赋予更丰富的内涵，特别是电子商务等高级Web应用的出现，HTML已经不能满足需要，XML（可扩展的标记语言）弥补了HTML的不足。它将数据和表示相分离。作为一种相对新的，方便的技术正被广泛的应用。

　　在使用XML技术时，我们会遇到大量数据需要发布，而这些数据大多保存在数据库中，例如，网上商店保存在数据库中的信息等。怎样快速把数据库中的数据转换为XML格式呢？下面就介绍用Delphi5.0中新增的ADO控件来快速开发XML。

　　首先，新建一个Access数据库，保存为db1.mdb，再在这个数据库中新建一张数据表保存为xx1，其中包括两个字段：

　　字段名称 字段类型
　　ID 自动编号（主键）
　　Xm 文本

　　表中其他属性按默认设置，为了简化，范例采用Access数据库，并且这个Access数据库将要被转换为XML。

　　然后，打开Delphi新建一个工程，在Form1上放置一个Button1，一个Savedialog1和一个ADO控件。ADO控件可以选AOODataset，也可以选AOOQuery或者AOOTable。属性设置相同，这里选用AOODataset。

　　最后，设置各个控件属性：

　　Button1.Caption:=转换为XML；
　　SaveDialog.Filter:= xml|*.xml;
　　SaveDialog.Defaultext:=xml;
　　ADODdataset1.Connectionstring:=Provider=Microsoft.Jet.OLEDB.4.0;DataSource=C:\My
　　Documents\db1.mdb;Persist Security Info=False；
　　ADODdataset1.CommandText:=select * from xx1 ；
　　Adodataset1.active:=true;

　　下面对以上ADODdataset1的属性进行解释。

　　属性ADODdataset1.Connectionstring是ADODdataset1连接Access数据库db1.mdb。ADODdataset1连接数据库有两种方法。一种是通过ODBC连接数据库，另一种是直接连接。这里采用直接连接的方法，点击属性框右边的省略号，弹出ADODdataset1的连接属性设置框，点击Build在Provider页选择选择驱动程序 Microsoft Jet OLE DB 4.0 Provider，下一步在Connection页选择数据库，点击第一项输入框右边的省略号，弹出对话框选择数据库，或者直接在输入框中填入数据库路径和数据库名 C：\My Documents\db1.mdb，最后点击Test Connection，弹出连接成功信息，点击确定。其他属性按默认设置。好了，ADODdataset1连接数据库成功。

　　属性ADODdataset1.CommandText是AODDataset1所要执行的sql语句，从数据表xx1中取出所有数据。该属性可以通过点击属性输入框右边的省略号来设置。点击省略号，在弹出的对话框中按提示选择数据表和字段，自动生成SQL语句 select * from xx1，也可以直接写SQL语句。点击确定完成设置。

　　属性Adodataset1.active的值设为TRUE使应用程序与数据库建立连接并保持连接状态。

　　到此为止，数据库的建立、连接和各个控件属性设置完成。

　　最后双击Form1上的“转换为XML”按钮在并且在它的OnClick事件处理程序中添加以下程序代码：

procedure TForm1.Button1Click(Sender: TObject);
　　begin
　　if savedialog1.Execute then
　　begin
　　adodataset1.SaveToFile(savedialog1.FileName,pfXML);
　　end;
　　end;

　　运行程序，当点击“转换为XML”按钮时，出现一个对话框，询问要把目前的数据库中的数据保存在哪个XML文件中。当输入文件名称后，应用程序就调用TADODataSet1的SaveToFile方法把数据库db1.mdb中表xx1的数据转换为XML格式输出。其中，TADODataSet1的SaveToFile方法接受两个参数，第一个参数是转换的文件名称，第二个参数是转换的格式（XML）。

　　单击保存。大功告成，我们已经把数据转换为XML格式。赶快用IE浏览刚才转换的XML文件吧，是不是看到自动生成的XML文件的内容了？

　　用Delphi的ADO控件把数据库转换为XML格式是不是很简单？赶快动手试一试吧。

由数据库数据生成xml的方法

procedure DatasetToXML(Dataset: TDataset; FileName: string);

unit DS2XML;

interface

uses
  Classes, DB;

procedure DatasetToXML(Dataset: TDataset; FileName: string);

implementation

uses
  SysUtils;

var
  SourceBuffer: PChar;

procedure WriteString(Stream: TFileStream; s: string);
begin
  StrPCopy(SourceBuffer, s);
  Stream.Write(SourceBuffer[], StrLen(SourceBuffer));
end;

procedure WriteFileBegin(Stream: TFileStream; Dataset: TDataset);

  function XMLFieldType(fld: TField): string;
  begin
    case fld.DataType of
      ftString: Result := "string" WIDTH=" + IntToStr(fld.Size) + ";
      ftSmallint: Result := "i4"; //??
      ftInteger: Result := "i4";
      ftWord: Result := "i4"; //??
      ftBoolean: Result := "boolean";
      ftAutoInc: Result := "i4" SUBTYPE="Autoinc";
      ftFloat: Result := "r8";
      ftCurrency: Result := "r8" SUBTYPE="Money";
      ftBCD: Result := "r8"; //??
      ftDate: Result := "date";
      ftTime: Result := "time"; //??
      ftDateTime: Result := "datetime";
    else
    end;
    if fld.Required then
      Result := Result + required="true";
    if fld.Readonly then
      Result := Result + readonly="true";
  end;

var
  i: Integer;
begin
  WriteString(Stream,   +
                      );
  WriteString(Stream, );

  {write th metadata}
  with Dataset do
    for i :=  to FieldCount- do
    begin
      WriteString(Stream, );
    end;
  WriteString(Stream, );
  WriteString(Stream, );
  WriteString(Stream, );
end;

procedure WriteFileEnd(Stream: TFileStream);
begin
  WriteString(Stream, );
end;

procedure WriteRowStart(Stream: TFileStream; IsAddedTitle: Boolean);
begin
  if not IsAddedTitle then
    WriteString(Stream, end;

procedure WriteRowEnd(Stream: TFileStream; IsAddedTitle: Boolean);
begin
  if not IsAddedTitle then
    WriteString(Stream, />);
end;

procedure WriteData(Stream: TFileStream; fld: TField; AString: ShortString);
begin
  if Assigned(fld) and (AString <> ) then
    WriteString(Stream, + fld.FieldName + =" + AString + ");
end;

function GetFieldStr(Field: TField): string;

  function GetDig(i, j: Word): string;
  begin
    Result := IntToStr(i);
    while (Length(Result) < j) do
      Result :=  + Result;
  end;

var Hour, Min, Sec, MSec: Word;
begin
  case Field.DataType of
    ftBoolean: Result := UpperCase(Field.AsString);
    ftDate: Result := FormatDateTime(yyyymmdd, Field.AsDateTime);
    ftTime: Result := FormatDateTime(hhnnss, Field.AsDateTime);
    ftDateTime: begin
                  Result := FormatDateTime(yyyymmdd, Field.AsDateTime);
                  DecodeTime(Field.AsDateTime, Hour, Min, Sec, MSec);
                  if (Hour <> ) or (Min <> ) or (Sec <> ) or (MSec <> ) then
                    Result := Result + T + GetDig(Hour, ) + : + GetDig(Min, ) + : + GetDig(Sec, ) + GetDig(MSec, );
                end;
  else
    Result := Field.AsString;
  end;
end;

procedure DatasetToXML(Dataset: TDataset; FileName: string);
var
  Stream: TFileStream;
  bkmark: TBookmark;
  i: Integer;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  SourceBuffer := StrAlloc();
  WriteFileBegin(Stream, Dataset);

  with DataSet do
  begin
    DisableControls;
    bkmark := GetBookmark;
    First;

    {write a title row}
    WriteRowStart(Stream, True);
    for i :=  to FieldCount- do
      WriteData(Stream, nil, Fields[i].DisplayLabel);
    {write the end of row}
    WriteRowEnd(Stream, True);

    while (not EOF) do
    begin
      WriteRowStart(Stream, False);
      for i :=  to FieldCount- do
        WriteData(Stream, Fields[i], GetFieldStr(Fields[i]));
      {write the end of row}
      WriteRowEnd(Stream, False);

      Next;
    end;

    GotoBookmark(bkmark);
    EnableControls;
  end;

  WriteFileEnd(Stream);
  Stream.Free;
  StrDispose(SourceBuffer);
end;

end. 

  生成XML文件。
  我使用下面的转换方法:
  I .   XML文件的根名与表名相同(本例就是country)。
  II.   每条来自于表的记录由<record></record>标记区分。
  III.  每个来自于表的数据由其字段名标记加以区分。

  - <country>
              - <Records>
                        <Name>Argentina</Name>
                        <Capital>Buenos Aires</Capital>
                        <Continent>South America</Continent>
                        <Area></Area>
                        <Population></Population>
                </Records>
                        .
                        .
                        .
     </country> 

  建立一个新的应用程序。放置一个Button和Table构件于主窗体上。设置表属性如下:
                  DatabaseName : DBDEMOS
                  Name : Table1
                  TableName : country (Remove the extention ".db")
                  Active : True 

  选择 Project/Import Type library。将会弹出 "Import Type Library" 对话框。从列表中选择 "Microsoft XML,Version
  2.0(version 2.0)" 然后点击 "Create Unit" 按钮。将会有一个 MSXML_TLB 单元加入你的工程.请将 MSXML_TLB 加入你要引用的单元的接口部分。然后在变量部分声明如下变量:
                DataList : TStringlist;
                  doc : IXMLDOMDocument;
                  root,child,child1 : IXMLDomElement;
                  text1,text2 : IXMLDOMText;
                  nlist : IXMLDOMNodelist;
                  dataRecord : String; 

  添加makeXml函数到你的单元。它将通过读取DBDEMOS中contry表中的数据生成一个XML文件。
  function TForm1.makeXml(table:TTable):Integer;
  var
    i   : Integer;
    xml,temp : String;
  begin
    try
      table.close;
      table.open;
      xml  := table.TableName;
      doc  := CreateOleObject(Microsoft.XMLDOM) as IXMLDomDocument;
      //Set the root name of the xml file as that of the table name.
      //In this case "country"
      root := doc.createElement(xml);
      doc.appendchild(root);
      //This while loop will go through the entaire table to generate the xml file
      while not table.eof do
      begin
        //adds the first level children , Records
        child:= doc.createElement(Records);
        root.appendchild(child);
        for i:= to table.FieldCount- do
        begin
          //adds second level children
          child1:=doc.createElement(table.Fields[i].FieldName);
          child.appendchild(child1);
          //Check field types
          case TFieldType(Ord(table.Fields[i].DataType)) of
          ftString:
          begin
            if Table.Fields[i].AsString = then
                 temp :=null  //Put a default string
               else
                 temp := table.Fields[i].AsString;
          end; 

          ftInteger, ftWord, ftSmallint:
          begin
              if Table.Fields[i].AsInteger >  then
                 temp := IntToStr(table.Fields[i].AsInteger)
               else
                 temp := ;
          end;
          ftFloat, ftCurrency, ftBCD:
          begin
              if table.Fields[i].AsFloat >  then
                temp := FloatToStr(table.Fields[i].AsFloat)
              else
                 temp := ;
          end;
          ftBoolean:
          begin
              if table.Fields[i].Value then
                temp:= True
              else
                temp:= False;
          end;
          ftDate:
          begin
              if (not table.Fields[i].IsNull) or
                 (Length(Trim(table.Fields[i].AsString)) > ) then
                temp := FormatDateTime(MM/DD/YYYY,
                               table.Fields[i].AsDateTime)
              else
                temp:= //; //put a valid default date
          end;
          ftDateTime:
          begin
              if (not table.Fields[i].IsNull) or
                 (Length(Trim(table.Fields[i].AsString)) > ) then
                temp := FormatDateTime(MM/DD/YYYY hh:nn:ss,
                               Table.Fields[i].AsDateTime)
              else
                temp := // ::; //Put a valid default date and time
          end;
          ftTime:
          begin
              if (not table.Fields[i].IsNull) or
                 (Length(Trim(table.Fields[i].AsString)) > ) then
                 temp := FormatDateTime(hh:nn:ss,
                             table.Fields[i].AsDateTime)
              else
                 temp := ::; //Put a valid default time
          end;
        end;
         //
         child1.appendChild(doc.createTextNode(temp));
        end;
      table.Next;
      end;
      doc.save(xml+.xml);
      memo1.lines.Append(doc.xml);
      Result:=;
    except
      on e:Exception do
        Result:=-;
    end;
  end; 

  在Button1的onclick事件中调用上面的函数
  procedure TForm1.Button1Click(Sender: TObject);
  begin
    if makeXml(table1)= then
      showmessage(XML Generated)
    else
      showmessage(Error while generating XML File);
  end; 

  如果你用IE 5.0(或以上版本)打开生成的country.xml文件,它看起来会成下面的样子
  - <country>
              - <Records>
                        <Name>Argentina</Name>
                        <Capital>Buenos Aires</Capital>
                        <Continent>South America</Continent>
                        <Area></Area>
                        <Population></Population>
                </Records>
              - <Records>
                        <Name>Bolivia</Name>
                        <Capital>La Paz</Capital>
                        <Continent>South America</Continent>
                        <Area></Area>
                        <Population></Population>
                </Records>
                        .
                        .
                        .
              - <Records>
                        <Name>Venezuela</Name>
                        <Capital>Caracas</Capital>
                        <Continent>South America</Continent>
                        <Area></Area>
                        <Population></Population>
                </Records>
    </country> 

  插入数据

  你已经将country表中存在的数据生成了XML文件。因此在这个XML文件中的数据就与country表中是一样的。如果你想将XML文件中的数据插入进country表中又不想删除原来存在的数据的话,将会有主键冲突的错误出现。因此必须先将country表中已经存在的数据删除掉。
  添加另一个按钮和一个memo构件于主窗体。在button2的onclick事件中添加如下代码.memo用来显示数据插入中的状态(成功/失败)。
  procedure TForm1.Button2Click(Sender: TObject);
  var
     i,ret_val,count:Integer;
     strData:String;
  begin
      //Before inserting data in to the country table,make sure that the data in
      //the generated xml file(country.xml) and country table(DBDEMOS) are
      //different.
      try
        count:=;
        DataList:=TStringList.Create;
        memo1.Clear;
        doc := CreateOleObject(Microsoft.XMLDOM) as IXMLDomDocument;
         //Load country.xml file
        doc.load(country.xml);
        nlist:=doc.getElementsByTagName(Records);
        memo1.lines.append(Table Name  :country);
        memo1.lines.append(---------------------);
        for i:= to nlist.Get_length- do
        begin
           travelChildren(nlist.Get_item(i).Get_childNodes);
           //Removes the first character(,) from dataRecord
           strData:=copy(dataRecord,,length(dataRecord));
           memo1.lines.append(strData);
           dataRecord:=;
           ret_val:=insertintotable(Datalist);
           if ret_val= then
               memo1.lines.append(Data inserted successfully.............!)
           else if ret_val=- then
               memo1.lines.append(Error while updating.....Try again.....!);
           memo1.lines.append(=============================================
                              +==(Record no. :+inttostr(count)+));
           DataList.Clear;
           count:=count+;
        end;
      except
        on e:Exception do
           Showmessage(e.message);
     end;
  end; 

  nlist(refer above program) contains a list of nodes.In our case the first node list is... 

          <Records>
                        <Name>Argentina</Name>
                        <Capital>Buenos Aires</Capital>
                        <Continent>South America</Continent>
                        <Area></Area>
                        <Population></Population>
                </Records> 

  我们传送此节点列表给一个递归函数,travelchildren。它将递归地沿着节点列表查找文本数据,并将此数据加入TStringList(Datalist)变量中。当完成第一轮后,Datalist中将会包含字符串 Argentina,Buenos Aires,South America,,.最后我们将此stringlist传送给函数 insertintotable,它将完成将一条记录插入 country 表的工作。重复此过程即可完成整个XML文件数据的插入工作。
  procedure TForm1.travelChildren(nlist1:IXMLDOMNodeList);
  var
     j:Integer;
     temp:String;
  begin
    for j:= to nlist1.Get_length- do
    begin
    //node type 1 means an entity and node type 5 means EntityRef
    if((nlist1.Get_item(j).Get_nodeType= ) or (nlist1.Get_item(j).Get_nodeType=)) then
      travelChildren(nlist1.Get_item(j).Get_childNodes)
      //node Type 3 means a text node,ie you find the data
      else if(nlist1.Get_item(j).Get_nodeType=) then
      begin
        temp:= trim(nlist1.Get_item(j).Get_nodeValue);
        dataRecord:=dataRecord+,+temp; //this is for displaying a single record on the memo
        DataList.Add(temp); //Datalist will contain one record after completing one full travel through the node list
      end
    end;
  end; 

  function TForm1.insertintotable(stpt:TStringList):Integer;
  var
    i:Integer;
  begin
    table1.close;
    table1.open;
    table1.Insert;
    for i :=  to stpt.Count -  do
    begin
         table1.Fields[i].AsVariant:= stpt[i];
    end;
    try
      table1.post;
      result:=;
    except
      on E:Exception do
        result:=-;
    end;
  end; 

  结论:
  你可以将此程序推广至任何数据库,由此数据可以通过XML文件在网络(即使是internet)中传输并在其实终端上更新数据库。我在生成XML文件中还未考虑特殊字符如 &,<,>,,等等。你可以在生成带这些字符的XML文件时作适合自己需要的改变