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;  
 

相关阅读 >>

Delphi xe3中使用tidftp的示例

Delphi firedac 下的 sqlite [10] - 使用 r-tree 搜索

Delphi inttostransi

阻止删除文件(文件占坑)的Delphi代码

Delphi 一个文件重复生成的小工具[附源码]

Delphi xe7中使用json

Delphi xe6 使用intent启动活动并在android应用程序中获取返回值的示例

Delphi trect的宽和高

Delphi filesearch 获取指定文件夹下所有文件包括隐藏文件

如何在Delphi xe中通过ftp下载文件

更多相关阅读请进入《Delphi》频道 >>

转载请注明出处：木庄网络博客 » delphi 几个DataSet数据导出到XML Word Excel TXT HTML的函数