用递归方法，使用 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文件时作适合自己需要的改变