由数据库数据生成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文件时作适合自己需要的改变。

查看本文来源