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;
@H_
403_14@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;
原文链接:https://www.f2er.com/xml/298793.html