delphi 几个DataSet数据导出到XML Word Excel TXT HTML的函数

interface  

  

uses DB;  

  

procedure ExpHTML(DataSet: TDataSet; const AFilePath: string);  

procedure ExpTXT(DataSet: TDataSet; const AFilePath: string);  

procedure ExpXLS(DataSet: TDataSet; const AFilePath: string);  

procedure ExpDOC(DataSet: TDataSet; const AFilePath: string);  

procedure ExpXML(DataSet: TDataSet; const AFilePath: string);  

  

implementation  

  

uses  

  dbWeb, Classes, ComObj, XMLDoc, XMLIntf, Variants;  

 

procedure ExpXML(DataSet : TDataSet; const AFilePath: string);  

var  

  i: integer;  

  xml: TXMLDocument;  

  reg, campo: IXMLNode;  

begin  

  xml := TXMLDocument.Create(nil);  

  try  

    xml.Active := True;  

    DataSet.First;  

    xml.DocumentElement :=  

      xml.CreateElement('DataSet','');  

    DataSet.First;  

    while not DataSet.Eof do  

    begin  

      reg := xml.DocumentElement.AddChild('row');  

      for i := 0 to DataSet.Fields.Count - 1 do  

      begin  

        campo := reg.AddChild(  

          DataSet.Fields[i].DisplayLabel);  

        campo.Text := DataSet.Fields[i].DisplayText;  

      end;  

      DataSet.Next;  

    end;  

    xml.SaveToFile(AFilePath);  

  finally  

    xml.free;  

  end;  

end;  

 

procedure ExpDOC(DataSet: TDataSet; const AFilePath: string);  

var  

  WordApp,WordDoc,WordTable,WordRange: Variant;  

  Row,Column: integer;  

begin  

  WordApp := CreateOleobject('Word.basic');  

  WordApp.Appshow;  

  WordDoc := CreateOleobject('Word.Document');  

  WordRange := WordDoc.Range;  

  WordTable := WordDoc.tables.Add(  

    WordDoc.Range,1,DataSet.FieldCount);  

  for Column:=0 to DataSet.FieldCount-1 do  

    WordTable.cell(1,Column+1).range.text:=  

      DataSet.Fields.Fields[Column].FieldName;  

  Row := 2;  

  DataSet.First;  

  while not DataSet.Eof do  

  begin  

     WordTable.Rows.Add;  

     for Column:=0 to DataSet.FieldCount-1 do  

       WordTable.cell(Row,Column+1).range.text :=  

         DataSet.Fields.Fields[Column].DisplayText;  

     DataSet.next;  

     Row := Row+1;  

  end;  

  WordDoc.SaveAs(AFilePath);  

  WordDoc := unAssigned;  

end;  

 

//导出到Excel  

 

procedure ExpXLS(DataSet: TDataSet; const AFilePath: string);  

var  

  ExcApp: OleVariant;  

  i,l: integer;  

begin  

  ExcApp := CreateOleObject('Excel.Application');  

  ExcApp.Visible := True;  

  ExcApp.WorkBooks.Add;  

  DataSet.First;  

  l := 1;    

  DataSet.First;  

  while not DataSet.EOF do  

  begin  

    for i := 0 to DataSet.Fields.Count - 1 do  

      ExcApp.WorkBooks[1].Sheets[1].Cells[l,i + 1] :=  

        DataSet.Fields[i].DisplayText;  

    DataSet.Next;  

    l := l + 1;  

  end;  

  ExcApp.WorkBooks[1].SaveAs(AFilePath);  

end;  

 

procedure ExpTXT(DataSet: TDataSet; const AFilePath: string);  

var  

  i: integer;  

  sl: TStringList;  

  st: string;  

begin  

  DataSet.First;  

  sl := TStringList.Create;  

  try  

    st := '';  

    for i := 0 to DataSet.Fields.Count - 1 do  

      st := st + DataSet.Fields[i].DisplayLabel + ';';  

    sl.Add(st);  

    DataSet.First;  

    while not DataSet.Eof do  

    begin  

      st := '';  

      for i := 0 to DataSet.Fields.Count - 1 do  

        st := st + DataSet.Fields[i].DisplayText + ';';  

      sl.Add(st);  

      DataSet.Next;  

    end;  

    sl.SaveToFile(AFilePath);  

  finally  

    sl.free;  

  end;  

end;  

 

   

 

procedure ExpHTML(DataSet: TDataSet; const AFilePath: string);  

var  

  sl: TStringList;  

  dp: TDataSetTableProducer;  

begin  

  sl := TStringList.Create;  

  try  

    dp := TDataSetTableProducer.Create(nil);  

    try  

      DataSet.First;  

      dp.DataSet := DataSet;  

      dp.TableAttributes.Border := 1;  

      sl.Text := dp.Content;  

      sl.SaveToFile(AFilePath);  

    finally  

      dp.free;  

    end;  

  finally  

    sl.free;  

  end;  

end;