由数据库数据生成XML的方法（有源码）

核心提示： PRocedure DatasetToxml(Dataset: TDataset; FileName: string); unit DS2XML; interface uses Classes, DB; procedure DatasetToXML(Dataset: TDataset; FileName: str

 

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文件时作适合自己需要的改变