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="子社区-1" catalog="sub1" />
<subBBS topic="子社区-2" catalog="sub2" />
</BBS>

</root>

View Code

程序代码如下：

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:=0 to XmlNode.ChildNodes.Count-1 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.

View Code

注意程序中 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;

View Code

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

//mmoRecod.Lines.Add(rootnode.Text); 
SetLength(files,chender.Count); 
for I := 0 to chender.Count-1 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;

View Code

上面是对节点相关的操作，基本上与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:=0 to SrcDataSet.FieldCount-1 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:=0 to SrcDataSet.FieldCount-1 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;

View Code

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

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

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

View Code

以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.

View Code

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

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

var Config:IXMLConfigType;
XMLDoc:IXMLDocument;
XMLFileName:String;
begin
XMLFileName:=ExtractFilePath(ParamStr(0))+'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:='123';
//读
showmessage(Config.ProductName);

XMLDoc.SaveToFile(XMLFileName);
end;

View Code

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[1].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[1].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>0 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[1].Text :='打开数据库时发生错误';
      query.Free;
      end;
    end;

end;
end.

View Code

从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;

View Code

用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;

View Code

　　下面对以上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;

View Code

　　运行程序，当点击“转换为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[0], 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 := 0 to FieldCount-1 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 := 0 + 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 <> 0) or (Min <> 0) or (Sec <> 0) or (MSec <> 0) then 
                    Result := Result + T + GetDig(Hour, 2) + : + GetDig(Min, 2) + : + GetDig(Sec, 2) + GetDig(MSec, 3); 
                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(1024); 
  WriteFileBegin(Stream, Dataset);

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

    {write a title row} 
    WriteRowStart(Stream, True); 
    for i := 0 to FieldCount-1 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 := 0 to FieldCount-1 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>2777815</Area> 
                        <Population>32300003</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:=0 to table.FieldCount-1 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 > 0 then 
                 temp := IntToStr(table.Fields[i].AsInteger) 
               else 
                 temp := 0; 
          end; 
          ftFloat, ftCurrency, ftBCD: 
          begin 
              if table.Fields[i].AsFloat > 0 then 
                temp := FloatToStr(table.Fields[i].AsFloat) 
              else 
                 temp := 0; 
          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)) > 0) then 
                temp := FormatDateTime(MM/DD/YYYY, 
                               table.Fields[i].AsDateTime) 
              else 
                temp:= 01/01/2000; //put a valid default date 
          end; 
          ftDateTime: 
          begin 
              if (not table.Fields[i].IsNull) or 
                 (Length(Trim(table.Fields[i].AsString)) > 0) then 
                temp := FormatDateTime(MM/DD/YYYY hh:nn:ss, 
                               Table.Fields[i].AsDateTime) 
              else 
                temp := 01/01/2000 00:00:00; //Put a valid default date and time 
          end; 
          ftTime: 
          begin 
              if (not table.Fields[i].IsNull) or 
                 (Length(Trim(table.Fields[i].AsString)) > 0) then 
                 temp := FormatDateTime(hh:nn:ss, 
                             table.Fields[i].AsDateTime) 
              else 
                 temp := 00:00:00; //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:=1; 
    except 
      on e:Exception do 
        Result:=-1; 
    end; 
  end; 
  
  在Button1的onclick事件中调用上面的函数
  procedure TForm1.Button1Click(Sender: TObject); 
  begin 
    if makeXml(table1)=1 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>2777815</Area> 
                        <Population>32300003</Population> 
                </Records> 
              - <Records> 
                        <Name>Bolivia</Name> 
                        <Capital>La Paz</Capital> 
                        <Continent>South America</Continent> 
                        <Area>1098575</Area> 
                        <Population>7300000</Population> 
                </Records> 
                        . 
                        . 
                        . 
              - <Records> 
                        <Name>Venezuela</Name> 
                        <Capital>Caracas</Capital> 
                        <Continent>South America</Continent> 
                        <Area>912047</Area> 
                        <Population>19700000</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:=1; 
        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:=0 to nlist.Get_length-1 do 
        begin 
           travelChildren(nlist.Get_item(i).Get_childNodes); 
           //Removes the first character(,) from dataRecord 
           strData:=copy(dataRecord,2,length(dataRecord)); 
           memo1.lines.append(strData); 
           dataRecord:=; 
           ret_val:=insertintotable(Datalist); 
           if ret_val=1 then 
               memo1.lines.append(Data inserted successfully.............!) 
           else if ret_val=-1 then 
               memo1.lines.append(Error while updating.....Try again.....!); 
           memo1.lines.append(============================================= 
                              +==(Record no. :+inttostr(count)+)); 
           DataList.Clear; 
           count:=count+1; 
        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>2777815</Area> 
                        <Population>32300003</Population> 
                </Records> 
  
  
  我们传送此节点列表给一个递归函数,travelchildren。它将递归地沿着节点列表查找文本数据,并将此数据加入TStringList(Datalist)变量中。当完成第一轮后,Datalist中将会包含字符串 Argentina,Buenos Aires,South America,2777815,32300003.最后我们将此stringlist传送给函数 insertintotable,它将完成将一条记录插入 country 表的工作。重复此过程即可完成整个XML文件数据的插入工作。
  procedure TForm1.travelChildren(nlist1:IXMLDOMNodeList); 
  var 
     j:Integer; 
     temp:String; 
  begin 
    for j:=0 to nlist1.Get_length-1 do 
    begin 
    //node type 1 means an entity and node type 5 means EntityRef 
    if((nlist1.Get_item(j).Get_nodeType= 1) or (nlist1.Get_item(j).Get_nodeType=5)) 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=3) 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 := 0 to stpt.Count - 1 do 
    begin 
         table1.Fields[i].AsVariant:= stpt[i]; 
    end; 
    try 
      table1.post; 
      result:=1; 
    except 
      on E:Exception do 
        result:=-1; 
    end; 
  end; 
  
  结论:
  你可以将此程序推广至任何数据库,由此数据可以通过XML文件在网络(即使是internet)中传输并在其实终端上更新数据库。我在生成XML文件中还未考虑特殊字符如 &,<,>,,等等。你可以在生成带这些字符的XML文件时作适合自己需要的改变

View Code

菜单 学习猿地 - LMONKEY

开通学习猿地VIP

尊享10项VIP特权 持续新增

知识通关挑战

打卡带练！告别无效练习

接私单赚外块

VIP优先接，累计金额超百万

学习猿地私房课免费学

大厂实战课仅对VIP开放

你的一对一导师

每月可免费咨询大牛30次

领取更多软件工程师实用特权

Java开发工程师

何以解忧，唯有 Java！

Python开发工程师

人生苦短我要学Python！

PHP开发工程师

PHP是世界上最好的编程语言!

GO开发工程师

想优雅的写程序，赶紧GO!

大数据开发工程师

弄大数据，就是在搞革命!

前端开发工程师

不仅最好，而且最全!

UI开发工程师

这个世界从来不缺少美，缺少你来创造美!

Linux运维工程师

不只是说说而已！

WEB前端1+X

不仅为考证，轻松做开发

计算机二级（C语言）

一切只为考证！

猿工手册

各种工具精挑细选

猿材料

各种工具精挑细选

猿代码

各种工具精挑细选

猿著课件

各种工具精挑细选

知识题库

知识闯关节节高，刷题涨知识！

阶段练习

单元测试知识学习状况秒掌握！

期末考试

期末测试，学习情况即刻知道！

面试题库

最新的企业技术人员招聘真题练习！

Java专区

2948篇 ｜ 24.5万人浏览

Python专区

2593篇 ｜ 19.5万人浏览

大数据专区

2948篇 ｜ 18.5万人浏览

PHP专区

3953篇 ｜ 27.5万人浏览

Go专区

1382篇 ｜ 12.5万人浏览

Web前端专区

1453篇 ｜ 31.5万人浏览

Linux云计算

1230篇 ｜ 4.5万人浏览

其他专区

53232篇文章 ｜ 11.5万人浏览

搜索

历史记录 清除记录

近期热搜

项目开发全程实录（电商EW_Shop）

8679 人 1年前

轻松学会Laravel-项目篇（商城API）

2022 人 1年前

Python数据分析2.0-金融

325 人 1年前

Python办公自动化2.0

241 人 1年前

使用账号登录

启用更安全省心的  微信登录

Java开发工程师

何以解忧，唯有 Java！

Python开发工程师

菜单学习猿地 - LMONKEY

尊享10项VIP特权持续新增

2948篇｜ 24.5万人浏览

2593篇｜ 19.5万人浏览

2948篇｜ 18.5万人浏览

3953篇｜ 27.5万人浏览

1382篇｜ 12.5万人浏览

1453篇｜ 31.5万人浏览

1230篇｜ 4.5万人浏览

53232篇文章｜ 11.5万人浏览

历史记录清除记录

2948篇｜ 24.5万人浏览

2593篇｜ 19.5万人浏览

2948篇｜ 18.5万人浏览

3953篇｜ 27.5万人浏览

1382篇｜ 12.5万人浏览

1453篇｜ 31.5万人浏览

1230篇｜ 4.5万人浏览

53232篇文章｜ 11.5万人浏览