Import و Export جدول ديتابيس به فايل XML

[MOJTABAATEFEH]

بوسيله روش زير شما مي توانيد از يك جدول يا يك كوئري خروجي XML بگيريد و يا مجددا اطلاعات يك فايل XML را به يك جدول منتقل كنيد :



در دلفي به مسير روبرو برويد Project/Import Type library
مورد Microsoft XML,Version 2.0(Version 2.0) را انتخاب كنيد و كليد Create Unit را بزنيد
به قسمت USES دومورد MSXML_TLB و Comobj را اضافه كنيد




var

DataList : TStringlist;

doc : IXMLDOMDocument;

root, child, child1 : IXMLDomElement;

text1, text2 : IXMLDOMText;

nlist : IXMLDOMNodelist;

dataRecord : String;

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;

root := doc.createElement(xml);
doc.appendchild(root);

while not table.eof do begin

child:= doc.createElement('Records');
root.appendchild(child);
for i:=0 to table.FieldCount-1 do begin

child1 := doc.createElement
(table.Fields[i].FieldName);
child.appendchild(child1);
case TFieldType
(Ord(table.Fields[i].DataType)) of
ftString:
begin
if Table.Fields[i].AsString ='' then
temp :='null'
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';
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';
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';
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;


procedure TForm1.Button1Click(Sender: TObject);
begin
if makeXml(table1)=1 then
showmessage('XML Generated')
else
showmessage('Error while generating XML File');
end;


procedure TForm1.travelChildren
(nlist1:IXMLDOMNodeList);
var
j:Integer;
temp:String;
begin
for j:=0 to nlist1.Get_length-1 do begin

if((nlist1.Get_item(j).Get_nodeType= 1)
or (nlist1.Get_item(j).Get_nodeType=5)) then
travelChildren
(nlist1.Get_item(j).Get_childNodes)

else if(nlist1.Get_item(j).Get_nodeType=3) then
begin
temp:= trim(nlist1.Get_item(j).Get_nodeValue);

dataRecord:=dataRecord+','+temp;

DataList.Add(temp);
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;



procedure TForm1.Button2Click(Sender: TObject);
var
i,ret_val,count : Integer;
strData : String;
begin
try
count:=1;
DataList:=TStringList.Create;
memo1.Clear;
doc := CreateOleObject('Microsoft.XMLDOM')
as IXMLDomDocument;

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);


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;



البته اين مثال در ويندوز XP بود ولي در ويندوز 7 هم امتحان كردم مشكلي نداشت فقط مورد 2 و 3 كمي تفاوت دارد

منبع : www.delphi.about.com