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

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

1. در دلفي به مسير روبرو برويد Project/Import Type library
2. مورد Microsoft XML,Version 2.0(Version 2.0) را انتخاب كنيد و كليد Create Unit را بزنيد
3. به قسمت 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