oracle的ado
导出函数
{
功能说明：导出数据,调用前先判断数据集为空，不进行导出
参数说明： I_Sql注意传入的Sql要注意用到索引.传入用做查询条件的Sql
}
//导出数据,FuncExportData('构成统计','构成统计',Dbgrid1);
Function FuncExportData(pFileName:String;pReportTitle:String;
pObjectSource:TObject;I_Sql :string;I_Query :TADOQUERY;
I_XMLDocument :TXMLDocument=nil;
I_XmlFileTile :string='';I_XmlRecTile :string=''):Boolean;
Function FuncExportData(pFileName:String;pReportTitle:String;
pObjectSource:TObject;I_Sql :string;I_Query :TADOQUERY;
I_XMLDocument :TXMLDocument=nil;
I_XmlFileTile :string='';I_XmlRecTile :string=''):Boolean;
Var
ExcelSaveDialog:TSaveDialog;
eclApp,WorkBook:Variant;
xlsFileName:String;
ColNumber,RowNumber:Integer;
V_Msg:String;
OutDir :string;
OutFileName :TFileName;
tmpfieldname : string;
i :integer;
stringlist :tstringlist;
MemoStr,LFormatStr:string;
//导出为XML文件
aNode, aValueNode: IXMLNode;
wStr: widestring;
begin
Result :=false;
try
//建立TSaveDialog构件
Application.CreateForm(TSaveDialog,ExcelSaveDialog);
//初始化保存文件盒的过滤器
ExcelSaveDialog.Filter:=
'XML文件|*.xml|Microsoft Excel 工作簿|*.xls|文本文件格式|*.txt';
//初始化保存文件盒的文件名
ExcelSaveDialog.FileName:=pFileName;
//判断如果没有填写文件名或单击保存文件取消，则退出该函数。
If Not ExcelSaveDialog.Execute Then
Exit;
case ExcelSaveDialog.FilterIndex of
1:begin//xml
if I_XMLDocument=nil then
begin
ExcelSaveDialog.free;
ExcelSaveDialog :=nil;
exit;
end;
//判断填写的文件是否带扩展名，如果没有扩展名，系统自动增加扩展名
//填写的文件名未带扩展名，系统自动增加扩展名
If Pos('.xml',LowerCase(ExcelSaveDialog.FileName))=0 Then
xlsFileName:=ExcelSaveDialog.FileName+'.xml'
Else
//填写的文件名自带扩展名，则系统不自动增加扩展名。
xlsFileName:=ExcelSaveDialog.FileName;
//判断文件是否存在，如果文件存在，则提示用户是否复盖。
If FileExists(xlsFileName) Then
Begin
V_Msg:=xlsFileName+'已经存在，';
//提示用户是否复盖原来文件，如果不复盖则退出该函数。
If MessageDlg(V_Msg+#13+'确认要替换文件吗？',mtInformation,
[mbYes,mbNo], 0)=mrNo then
begin
ExcelSaveDialog.free;
ExcelSaveDialog :=nil;
Exit;
end
Else
//删除文件，如果失败，则提示错误信息并退出该函数。
If Not DeleteFile(xlsFileName) Then
begin
MessageDlg('不能正确操作该文件'+#13+
'可能是该文件已被其他程序打开, 或系统错误'
,mtInformation, [mbYes], 0);
ExcelSaveDialog.free;
ExcelSaveDialog :=nil;
exit;
end;
End;
//如果存在
I_XMLDocument.Active :=false;
I_XMLDocument.LoadFromFile(ExtractFilePath(Application.ExeName)+'test.xml');
I_XMLDocument.Active:=true;
I_XMLDocument.CleanupInstance;
//先创建头文件
with I_XMLDocument.XML do
begin
Add('<?xml version="1.0" encoding="GB2312" ?> ');
Add('<'+I_XmlFileTile+'>');
Add('</'+I_XmlFileTile+'>');
end;
I_XMLDocument.Active := true;
//if FileExists(xlsFileName) then
//deletefile(xlsFileName);
I_XMLDocument.SaveToFile(ExtractFilePath(Application.ExeName)+'test.xml');
Try
//对数据集做循环，然后按Grid把每个属性加进入
If UpperCase(pObjectSource.ClassName) = 'TDBGRID' Then
Begin
//根据传入的Sql进行查询，加上导出的数据
FuncQueryOpen(I_Query,I_Sql);
If Not I_Query.IsEmpty Then
Begin
I_Query.DisableControls;
try
I_Query.First;
While Not I_Query.Eof Do
Begin
//加节点操作
aNode :=I_XMLDocument.DocumentElement
.AddChild(I_XmlRecTile);
For ColNumber:=0 To
TDBGrid(pObjectSource).Columns.Count-1 Do
Begin
Try
//加数据，第一个参数为属性标题数值，第3个为
//该属性对应的数值
aNode.SetAttributeNS(TDBGrid(pObjectSource)
.Columns.Items[ColNumber].Title.Caption,
'',I_Query.FieldByName(TDBGrid(pObjectSource).
Columns.Items[ColNumber].FieldName).AsString);
Except
End;
End;
I_Query.Next;
End;
finally
I_Query.EnableControls;
end;
End;
End;
I_XMLDocument.SaveToFile(xlsFileName);
// eclApp:=Unassigned;
V_Msg:='数据导出成功，存放在'+xlsFileName;
MessageDlg(V_Msg,mtInformation, [mbYes], 0);
Result:=True;
except
MessageDlg('不能正确操作该文件'+#13+
'可能是该文件已被其他程序打开, 或系统错误'
,mtInformation, [mbYes], 0);
ExcelSaveDialog.free;
ExcelSaveDialog :=nil;
exit;
end;
end;
2://xls
begin
//判断填写的文件是否带扩展名，如果没有扩展名，系统自动增加扩展名
//填写的文件名未带扩展名，系统自动增加扩展名
If Pos('.xls',LowerCase(ExcelSaveDialog.FileName))=0 Then
xlsFileName:=ExcelSaveDialog.FileName+'.xls'
Else
//填写的文件名自带扩展名，则系统不自动增加扩展名。
xlsFileName:=ExcelSaveDialog.FileName;
//判断文件是否存在，如果文件存在，则提示用户是否复盖。
If FileExists(xlsFileName) Then
Begin
V_Msg:=xlsFileName+'已经存在，';
//提示用户是否复盖原来文件，如果不复盖则退出该函数。
If MessageDlg(V_Msg+#13+'确认要替换文件吗？',mtInformation,
[mbYes,mbNo], 0)=mrNo then
begin
ExcelSaveDialog.free;
ExcelSaveDialog :=nil;
Exit;
end
Else
//删除文件，如果失败，则提示错误信息并退出该函数。
If Not DeleteFile(xlsFileName) Then
begin
MessageDlg('不能正确操作该文件'+#13+
'可能是该文件已被其他程序打开, 或系统错误'
,mtInformation, [mbYes], 0);
ExcelSaveDialog.free;
ExcelSaveDialog :=nil;
exit;
end;
End;
Try
eclApp:=CreateOleObject('Excel.Application');
//WorkBook:=CreateOleobject('Excel.Sheet');
Except
MessageDlg('打开Microsoft Excel出错！'
,mtInformation, [mbYes], 0);
ExcelSaveDialog.free;
ExcelSaveDialog :=nil;
Exit;
End;
Try
//WorkBook:=eclApp.workBooks.Add;
eclApp.workBooks.Add;
WorkBook :=eclApp.WorkBooks[1].WorkSheets[1];
WorkBook.Cells(1,1):=pReportTitle;
If UpperCase(pObjectSource.ClassName) = 'TDBGRID' Then
Begin
{将DBGrid列标题名写入Excel文件中}
For ColNumber:=0 To TDBGrid(pObjectSource).Columns.Count-1 Do
WorkBook.Cells(2,ColNumber+1):=
TDBGrid(pObjectSource).Columns.Items[ColNumber]
.Title.Caption;
{将DBGrid中的记录写入Excel文件中}
RowNumber:=3;
//根据传入的Sql进行查询，加上导出的数据
FuncQueryOpen(I_Query,I_Sql);
If Not I_Query.IsEmpty Then
Begin
I_Query.DisableControls;
try
I_Query.First;
While Not I_Query.Eof Do
Begin
For ColNumber:=0 To
TDBGrid(pObjectSource).Columns.Count-1 Do
Begin
Try
WorkBook.Cells(RowNumber,ColNumber+1)
:=I_Query.FieldByName(TDBGrid(pObjectSource).
Columns.Items[ColNumber].FieldName).AsString;
Except
WorkBook.Cells(RowNumber,ColNumber+1):='';
End;
End;
RowNumber:=RowNumber+1;
I_Query.Next;
End;
finally
I_Query.EnableControls;
end;
End;
End;
WorkBook.saveas(xlsFileName);
try
//关闭所有工作页
for i:=1 to eclApp.WorkBooks.count do
eclApp.WorkBooks.Close;
finally
eclApp.Quit;
end;
// eclApp:=Unassigned;
V_Msg:='数据导出成功，存放在'+xlsFileName;
MessageDlg(V_Msg,mtInformation, [mbYes], 0);
Result:=True;
except
MessageDlg('不能正确操作该文件'+#13+
'可能是该文件已被其他程序打开, 或系统错误'
,mtInformation, [mbYes], 0);
ExcelSaveDialog.free;
ExcelSaveDialog :=nil;
try
for i:=1 to eclApp.WorkBooks.count do
eclApp.WorkBooks.Close;
finally
eclApp.Quit;
end;
exit;
end;
end;
3://.txt;
begin
//判断填写的文件是否带扩展名，如果没有扩展名，系统自动增加扩展名
If Pos('.txt',LowerCase(ExcelSaveDialog.FileName))=0 Then
xlsFileName:=ExcelSaveDialog.FileName+'.txt'
Else
xlsFileName:=ExcelSaveDialog.FileName;
If FileExists(xlsFileName) Then
Begin
V_Msg:=xlsFileName+'已经存在，';
//提示用户是否复盖原来文件，如果不复盖则退出该函数。
If MessageDlg(V_Msg+#13+'确认要替换文件吗？',mtInformation,
[mbYes,mbNo], 0)=mrNo then
begin
ExcelSaveDialog.free;
ExcelSaveDialog :=nil;
Exit;
end
Else
//删除文件，如果失败，则提示错误信息并退出该函数。
If Not DeleteFile(xlsFileName) Then
begin
MessageDlg('不能正确操作该文件'+#13+
'可能是该文件已被其他程序打开, 或系统错误'
,mtInformation, [mbYes], 0);
ExcelSaveDialog.free;
ExcelSaveDialog :=nil;
exit;
end;
End;
OutDir := '';
OutFileName := xlsFileName;
while pos('/',OutFileName)<>0 do
begin
OutDir := OutDir + Copy(OutFileName,1,pos('/',OutFileName));
OutFileName := Copy(OutFileName,pos('/',OutFileName)+1,
Length(OutFileName));
end;
try
//先加上标题
stringlist :=Tstringlist.create;
stringlist.Clear;
stringlist.add(pReportTitle);
If UpperCase(pObjectSource.ClassName) = 'TDBGRID' Then
Begin
//将DBGrid列标题名写入txt文件中}
//只定位20格式输出，以后肯定要改的
For ColNumber:=0 To TDBGrid(pObjectSource).Columns.Count-1 Do
begin
LFormatStr :=LFormatStr+
format('%20s',[TDBGrid(pObjectSource).Columns.
Items[ColNumber].Title.Caption]);
{将DBGrid中的记录写入Excel文件中}
end;
stringlist.add(LFormatStr);
//Writeln(' ');
//根据传入的Sql进行查询，加上导出的数据
FuncQueryOpen(I_Query,I_Sql);
If Not I_Query.IsEmpty Then
Begin
I_Query.DisableControls;
try
I_Query.First;
While Not I_Query.Eof Do
Begin
MemoStr :='';
For ColNumber:=0 To TDBGrid(pObjectSource).Columns.Count-1 Do
Begin
//第二行开始加数据
LFormatStr :=
format('%20s',[I_Query
.FieldByName(TDBGrid(pObjectSource).Columns
.Items[ColNumber].FieldName).AsString]);
MemoStr :=MemoStr+LFormatStr;
End;
RowNumber:=RowNumber+1;
stringlist.add(MemoStr);
I_Query.Next;
End;
finally
I_Query.EnableControls;
end;
End;
End;
try
stringlist.SaveToFile(xlsFileName);
except
ExcelSaveDialog.free;
ExcelSaveDialog :=nil;
stringlist.free;
stringlist :=nil;
MessageDlg('导出文件出错！',mtInformation, [mbYes], 0);
exit;
end;
stringlist.free;
V_Msg := '数据导出成功，存放在' + xlsFileName;
MessageDlg(V_Msg,mtInformation, [mbYes], 0);
Result := True;
except
MessageDlg('不能正确操作该文件'+#13+
'可能是该文件已被其他程序打开, 或系统错误'
,mtInformation, [mbYes], 0);
ExcelSaveDialog.free;
ExcelSaveDialog :=nil;
exit;
end;
end;//end 3
end;
finally
ExcelSaveDialog.free;
ExcelSaveDialog :=nil;
end;
end;
导入的发给你，邮箱？
