Delphi 6 含有许多更新更强的XML支持功能。Delphi早期版本中提到的XML只在说明MIDAS数据格式和XMLBroker组件(在ClientDataSet和ADODataSet组件中也提到过)。[blue][h4]Delphi 6提供的XML功能增加了XML文件编程，XML数据绑定向导，XML映象和BizSnap(SOAP/XML Web服务)。本文是三篇论述Delphi 6中XML功能系列文章的第一篇，论述Delphi 6中的XML文件编程。[/h4][/blue]
[blue][h4]本文提供的Delphi代码可以将XML文件作为数据库转换的中间介质。[/h4][/blue]
本文说明如何从一个Paradox数据库读取数据，生成XML文件，然后将XML文件中的数据插入到一个新的表中。这个新的数据库表可以还是Paradox，也可以是任何Delphi能够访问的数据库。我使用MSXML来解析XML文件，因此你必须使用IE 5.0以上才能使用我的代码。
生成XML文件
转换生成XML文件的过程如下。
XML文件的根名字与表名相同(本例是"country")。
标记<Records>和</Records>之间是各个纪录。
XML中节点元素标记<Field Name>和</Field Name>之间是数据。
<country>
<Records>
<Name>Argentina</Name>
<Capital>Buenos Aires</Capital>
<Continent>South America</Continent>
<Area>2777815</Area>
<Population>32300003</Population>
</Records>
.
.
</country>
启动一个新应用(application)，在主窗口(Main Form)中加入按钮(TButton)和表(TTable)控件。Tabled的设置如下：
DatabaseName : DBDEMOS
Name : Table1
TableName : country (不要后缀 ".db")
Active : True
选择主菜单Project/Import，导入数据库类型。
选择"Microsoft XML, Version 2.0 (version 2.0)"，然后点击"Create Unit"按钮。此后，就有一个MSXML_TLB增加到你的工程(project)文件中。要在unit文件的interface段的uses说明里加上MSXML_TLB。
在变量声明中作如下声明：
DataList : TStringlist;
doc : IXMLDOMDocument;
root, child, child1 : IXMLDomElement;
text1, text2 : IXMLDOMText;
nlist : IXMLDOMNodelist;
dataRecord : String;
在执行部分加入以下代码，这就可以从country表中读取数据并生成XML文件。
function TForm1.makeXml(table:TTable):Integer;
var
i : Integer;
xml : String;
begin
try
table.close;
table.open;
xml := table.TableName;
do
c := CreateOleObject('Microsoft.XMLDOM') as IXMLDomDocument;
// 设置XML文件的根名字为"country"，与表名相同。
root :=do
c.createElement(xml);
// 把根节点加入到文件中
do
c.appendchild(root);
// 循环产生整个XML文件
while not table.eofdo
begin
// 加入第一级子节点，即纪录
child:=do
c.createElement('Records');
root.appendchild(child);
// 加入第二级子节点
for i:=0 to table.FieldCount-1do
begin
child1:=doc.createElement(table.Fields.FieldName);
child1.appendChild(doc.createTextNode(table.Fields.value));
child.appendchild(child1);
end;
table.Next;
end;
do
c.save(xml+'.xml');
Result:=1;
except
on e:Exceptiondo
Result:=-1;
end;
end;
Call the function in Button1's click event:
procedure TForm1.Button1Click(Sender: TObject);
begin
if makeXml(table1)=1 then
showmessage('XML Generated')
else
showmessage('Error while generating XML File');
end;
随后用IE浏览器打开XML文件(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>
生成新表
XML文件中的数据与原表的数据完全一样。如果直接将数据插入回原表，会导致主索引出错。所以如果真想这么作得话，要事先删除原表。
在主窗口上增加另一个按钮和一个memo控件。为第二个按钮填写以下onclick事件代码。(memo用于显示数据插入成功与否的信息)。
procedure TForm1.Button2Click(Sender: TObject);
var
i,ret_val,count:Integer;
strData:String;
begin
// 注意：在向country表插入数据前，确认XML文件中的数据与原表数据是不同的。或者作一个新表。
try
count:=1;
DataList:=TStringList.Create;
memo1.Clear;
do
c := CreateOleObject('Microsoft.XMLDOM') as IXMLDomDocument;
// 加载country.xml文件
do
c.load('country.xml');
nlist:=doc.getElementsByTagName('Records');
memo1.lines.append('Table Name :country');
memo1.lines.append('---------------------');
for i:=0 to nlist.Get_length-1do
begin
travelChildren(nlist.Get_item(i).Get_childNodes);
// 从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:Exceptiondo
Showmessage(e.message);
end;
end;
nlist是节点列表。在本例中，第一个节点是：
<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等字符串。然后把这个字符串传递给insertintotable函数，让它在country表中插入一条纪录。循环这个过程直至完成遍历整个XML文件。
procedure TForm1.travelChildren(nlist1:IXMLDOMNodeList);
var
j:Integer;
temp:String;
begin
for j:=0 to nlist1.Get_length-1do
begin
// 节点类型1表示是一个实体(entity)，节点类型5表示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)
// 节点类型3表示文本节点，即找到数据
else
if(nlist1.Get_item(j).Get_nodeType=3) then
begin
temp:= trim(nlist1.Get_item(j).Get_nodeValue);
dataRecord:=dataRecord+','+temp;
//在memo显示一条纪录
DataList.Add(temp);
// 完成一次节点扫描后包含一条纪录的信息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 - 1do
table1.Fields.AsVariant:=stpt;
try
table1.post;
result:=1;
except
on E:Exceptiondo
result:=-1;
end;
end;
这个程序可以用于任何数据库，因此数据能以XML文件形式在网络(或者在互联网)上传递，实现远程更新。
如有问题，可与我联系。
[blue][h4]本文介绍了如何创建XML dataset，然后通过XML文件里的元素对XML“表”动态地创建相应控件。[/h4][/blue]
本文介绍了如何创建XML dataset，然后通过XML文件里的元素对XML“表”动态地创建相应控件。文末所附的工程(Project)文件，使用户可以创建简单的(非关系型)数据库，这个数据库用XML文件存储。随后加载这个XML文件，经解析之后，可以在用户自行定义的“数据库”输入界面上动态生成控件。
大家都习惯使用Delphi来编程，实在太容易了。一桩困难的任务可以变得简单得多，伤透脑筋的结构设计可以轻易完成。感谢Delphi提供的这种灵活实用的工具，和优雅的界面风格。
Delphi 6问世，提供了新的组件，使开发者能够创建和管理XML文件。例如，在Interner组里提供了XMLDocument组件，在Data Access组里提供了XMLTransform, XMLTransformProvider, and XMLTransformClient组件集。
另外，在主菜单的File | New | Other | New下，你能找到XML数据绑定向导(XML Data Binding Wizard)。如果还不够，你可以使用XML映象器(Tools | XML Mapper or Programs | Borland Delphi 6 | XML Mapper)。尽管Delphi已经提供了如此之多的捷径来产生和使用XML文件，Borland公司还是向我们提供了“免动脑筋”的解决方案 - 使用“即试即用”的TClientDataSet。
从TClientDataSet到XML
用TClientDataSet创建和加载XML文件是很容易的，调用SaveToFile和LoadToFile函数即可，只要对函数的第二个参数设置相应的XML类型。实际上，有三个参数类型，一个是遗留的dfBinary二进制类型，另外是dfXMLUTF8和UTF8-based XML类型。
例如，可以这样存储文件(代码中的cds是TClientDataSet，FCurrentDataBaseName是文件名)：
cds.SaveToFile(Format('%s.xml', [FCurrentDataBaseName]), dfXMLUTF8);
这样你就得到了XML文件。
动态创建相应的控件
当然，在调用SaveToFile之前，还得创建数据库。这也不难，如下例。假设有两个TListBox控件，一个存放域名(lstbxFields)，另一个存放相应的数据类型(lstbxDataTypes)，动态创建控件的过程如下：
{----------------------------------------------------}
procedure TfEZDBBrowserAddEditDelete.Cre8Controls;
const
{ DYNAMIC_CONTROLS_TOP：第一个控件与顶部的距离}
DYNAMIC_CONTROLS_TOP = 24;
DYNAMIC_CONTROLS_LEFT = 12;
{ 为简短起见，省略其它常量}
var
i: Integer;
iCurrentRow, iCurrentTop, iControlsOnThisRow, iCurrentWidthOfControls: Integer;
MemoOnThisRow: Boolean;
procedure Cre8StringLabeledEdit(ACaption: String);
begin
with TLabeledEdit.Create(Self)do
begin
Parent := scrlbx;
Name := Format('lbledt%s', [ACaption]);
{ HelpContext用于映射控件和表格索引(grid index 3 = (control with HelpContext 3), 等等)}
HelpContext := HELP_CONTEXT_OFFSET+i;
Hint := ACaption;
EditLabel.Caption := ACaption;
EditLabel.Font.Style := EditLabel.Font.Style+[fsBold];
Text := '';
{ 扩展宽度，使可输入长串}
Width := LABELED_EDIT_STRING_WIDTH;
grdcds.Columns.Width := GRID_COLUMN_ALPHA_WIDTH;
{ 如果当前行宽不合适，去下一行}
if (iCurrentWidthOfControls + LABELED_EDIT_STRING_WIDTH +
(SPACE_BETWEEN_DYNAMICALLY_CREATED_CONTROLS * iControlsOnThisRow)) >
MAX_WIDTH_OF_CONTROLS then
begin
inc(iCurrentRow);
iControlsOnThisRow := 1;
if MemoOnThisRow then
Top := (SPACE_BETWEEN_DYNAMICALLY_CRE8ED_ROWS * iCurrentRow)+MEMO_HEIGHT
else
Top := iCurrentTop+SPACE_BETWEEN_DYNAMICALLY_CRE8ED_ROWS;
iCurrentTop := Top;
MemoOnThisRow := False;
Left := DYNAMIC_CONTROLS_LEFT;
iCurrentWidthOfControls := LABELED_EDIT_STRING_WIDTH;
end
else
begin
Top := iCurrentTop;
if iCurrentWidthOfControls = 0 then
begin
Left := DYNAMIC_CONTROLS_LEFT;
if iCurrentRow=0 then
FFirstDynamicControl := Name;
end
else
Left := iCurrentWidthOfControls + (SPACE_BETWEEN_DYNAMICALLY_CREATED_CONTROLS *
iControlsOnThisRow) + DYNAMIC_CONTROLS_LEFT;
inc(iControlsOnThisRow);
iCurrentWidthOfControls := iCurrentWidthOfControls + LABELED_EDIT_STRING_WIDTH;
end;
OnEnter := DynamicControlEnter;
OnExit := DynamicControlExit;
Tag := LABELED_EDIT_STRING_TAG;
end;
end;
{ 创建Memos有一个特别问题：Memo很长时，要随时保留回车键("crlf")位置，用于调整屏幕顶端位置。}
procedure Cre8Memo(ACaption: String);
var mmoLeft, mmoTop: Integer;
begin
with TMemo.Create(Self)do
begin
Parent := scrlbx;
Name := Format('mmo%s', [ACaption]);
HelpContext := HELP_CONTEXT_OFFSET+i;
Hint := ACaption;
Text := '';
Scrollbars := ssVertical;
{ 如果当前行宽不合适，去下一行}
if (iCurrentWidthOfControls + MEMO_WIDTH + (SPACE_BETWEEN_DYNAMICALLY_CREATED_CONTROLS *
iControlsOnThisRow)) > MAX_WIDTH_OF_CONTROLS then
begin
inc(iCurrentRow);
iControlsOnThisRow := 1;
if MemoOnThisRow then
Top := iCurrentTop + SPACE_BETWEEN_DYNAMICALLY_CRE8ED_ROWS + MEMO_HEIGHT
else
Top := iCurrentTop + SPACE_BETWEEN_DYNAMICALLY_CRE8ED_ROWS;
iCurrentTop := Top;
Left := DYNAMIC_CONTROLS_LEFT;
iCurrentWidthOfControls := MEMO_WIDTH;
end
else
begin
Top := iCurrentTop;
if iCurrentWidthOfControls = 0 then
begin
Left := DYNAMIC_CONTROLS_LEFT;
if iCurrentRow=0 then
FFirstDynamicControl := Name;
end
else
Left := iCurrentWidthOfControls + (SPACE_BETWEEN_DYNAMICALLY_CREATED_CONTROLS *
iControlsOnThisRow) + DYNAMIC_CONTROLS_LEFT;
inc(iControlsOnThisRow);
iCurrentWidthOfControls := iCurrentWidthOfControls + MEMO_WIDTH;
end;
{ 现在可以在行例设置memo了}
MemoOnThisRow := True;
mmoLeft := Left;
mmoTop := Top;
OnEnter := DynamicControlEnter;
OnExit := DynamicControlExit;
Tag := MEMO_MEMO_TAG;
end;
{ 在上面设置标签}
with TLabel.Create(Self)do
begin
Parent := scrlbx;
{ 也许可以不用Name... }
Name := Format('lbl%s', [ACaption]);
Caption := ACaption;
Font.Style := Font.Style+[fsBold];
Left := mmoLeft;
Top := mmoTop-LBL_VERTICAL_DELTA;
end;
end;
procedure Cre8MoneyLabeledEdit(ACaption: String);
{为简短起见，这里省略代码，可到附件下载}
procedure Cre8IntegerLabeledEdit(ACaption: String);
{为简短起见，这里省略代码，可到附件下载}
procedure Cre8FloatLabeledEdit(ACaption: String);
{为简短起见，这里省略代码，可到附件下载}
procedure Cre8ComboBox(ACaption: String);
{为简短起见，这里省略代码，可到附件下载}
begin
{ 初始化变量}
iCurrentRow := 0;
iCurrentWidthOfControls := 0;
iControlsOnThisRow := 0;
iCurrentTop := DYNAMIC_CONTROLS_TOP;
MemoOnThisRow := False;
dm.cds.Active := True;
{do
not want todo
this in the DM's Create, as the CDS must be active first }
dm.cds.LogChanges := False;
for i := 0 to Pred(dm.CDS.FieldList.Count)do
begin
with dm.CDS.Fieldsdo
begin
if (Fields is TStringField) then
Cre8StringLabeledEdit(Fields.FieldName)
else
if (Fields is TMemoField) then
Cre8Memo(Fields.FieldName)
else
if (Fields is TCurrencyField) then
Cre8MoneyLabeledEdit(Fields.FieldName)
else
if (Fields is TIntegerField) then
Cre8IntegerLabeledEdit(Fields.FieldName)
else
if (Fields is TFloatField) then
Cre8FloatLabeledEdit(Fields.FieldName)
else
if (Fields is TDateField) then
Cre8DateTimePicker(Fields.FieldName)
else
if (Fields is TBooleanField) then
Cre8ComboBox(Fields.FieldName);
end;
end;
Popul8DynamicControls;
end;