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 几个DataSet数据导出到XML Word Excel TXT HTML的函数

相关推荐

评论
