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文件時作適合自己需要的改變