在开发数据库应用程序中,经常要将类型相同的数据导出来,放到Excel文件中,利用Excel强大的编辑功能,对数据作进一步的加工处理。这有许多的方法,我们可以使用OLE技术,在Delphi中创建一个自动化对象,通过该对象来传送数据。也可以使用ADO,通过与Excel数据存储建立连接,使用ADO这种独立于数据库后端的技术来导出数据集的数据。
可这两种技术都有一个共同的缺点,那就是慢,数据量少还好,用户不会有太多的感觉,可一旦数据量大,比如,超过1千条,速度就让人难以忍受了,那么有没有更好的办法,既可以快速地导出数据,又不用安装附加的软件。也许好多人都想到了剪贴板的方式,这种方式速度是快,可也有不好的一面,那就是数据量大占用内存也大,并且在Excel中调用PASTE方法时,需要锁定输入,这使用起来,就有点不方便了
这里我为大家介始一种比较好的方法,使用文件流的方式,通过TfileStream直接写入Excel文件。我写了一个函数,通过它可将数据集中的数据直接导入到Excel文件中。我测试了一下,1M的数据,不到十秒就完成了。附源程序。
首先在你的程序中定义以下几个数组:
arXlsBegin: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
arXlsEnd: array[0..1] of Word = ($0A, 00);
arXlsString: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
arXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
arXlsInteger: array[0..4] of Word = ($27E, 10, 0, 0, 0);
arXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);
接着调用下面的函数。
Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean; aDataSet: TDataSet);
var
i, j: integer;
Col, row: word;
ABookMark: TBookMark;
aFileStream: TFileStream;
procedure incColRow; //增加行列号
begin
if Col = ADataSet.FieldCount - 1 then
begin
Inc(Row);
Col :=0;
end
else
Inc(Col);
end;
procedure WriteStringCell(AValue: string);//写字符串数据
var
L: Word;
begin
L := Length(AValue);
arXlsString[1] := 8 + L;
arXlsString[2] := Row;
arXlsString[3] := Col;
arXlsString[5] := L;
aFileStream.WriteBuffer(arXlsString, SizeOf(arXlsString));
aFileStream.WriteBuffer(Pointer(AValue)^, L);
IncColRow;
end;
procedure WriteIntegerCell(AValue: integer);//写整数
var
V: Integer;
begin
arXlsInteger[2] := Row;
arXlsInteger[3] := Col;
aFileStream.WriteBuffer(arXlsInteger, SizeOf(arXlsInteger));
V := (AValue shl 2) or 2;
aFileStream.WriteBuffer(V, 4);
IncColRow;
end;
procedure WriteFloatCell(AValue: double);//写浮点数
begin
arXlsNumber[2] := Row;
arXlsNumber[3] := Col;
aFileStream.WriteBuffer(arXlsNumber, SizeOf(arXlsNumber));
aFileStream.WriteBuffer(AValue, 8);
IncColRow;
end;
begin
if FileExists(FileName) then DeleteFile(FileName); //文件存在,先删除
aFileStream := TFileStream.Create(FileName, fmCreate);
Try
//写文件头
aFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin));
//写列头
Col := 0; Row := 0;
if bWriteTitle then
begin
for i := 0 to aDataSet.FieldCount - 1 do
WriteStringCell(aDataSet.Fields[i].FieldName);
end;
//写数据集中的数据
aDataSet.DisableControls;
ABookMark := aDataSet.GetBookmark;
aDataSet.First;
while not aDataSet.Eof do
begin
for i := 0 to aDataSet.FieldCount - 1 do
case ADataSet.Fields[i].DataType of
ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
WriteIntegerCell(aDataSet.Fields[i].AsInteger);
ftFloat, ftCurrency, ftBCD:
WriteFloatCell(aDataSet.Fields[i].AsFloat)
else
WriteStringCell(aDataSet.Fields[i].AsString);
end;
aDataSet.Next;
end;
//写文件尾
AFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));
if ADataSet.BookmarkValid(ABookMark) then aDataSet.GotoBookmark(ABookMark);
Finally
AFileStream.Free;
ADataSet.EnableControls;
end;
end;
以上程序,在DELPHI中通过测试!
可这两种技术都有一个共同的缺点,那就是慢,数据量少还好,用户不会有太多的感觉,可一旦数据量大,比如,超过1千条,速度就让人难以忍受了,那么有没有更好的办法,既可以快速地导出数据,又不用安装附加的软件。也许好多人都想到了剪贴板的方式,这种方式速度是快,可也有不好的一面,那就是数据量大占用内存也大,并且在Excel中调用PASTE方法时,需要锁定输入,这使用起来,就有点不方便了
这里我为大家介始一种比较好的方法,使用文件流的方式,通过TfileStream直接写入Excel文件。我写了一个函数,通过它可将数据集中的数据直接导入到Excel文件中。我测试了一下,1M的数据,不到十秒就完成了。附源程序。
首先在你的程序中定义以下几个数组:
arXlsBegin: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
arXlsEnd: array[0..1] of Word = ($0A, 00);
arXlsString: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
arXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
arXlsInteger: array[0..4] of Word = ($27E, 10, 0, 0, 0);
arXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);
接着调用下面的函数。
Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean; aDataSet: TDataSet);
var
i, j: integer;
Col, row: word;
ABookMark: TBookMark;
aFileStream: TFileStream;
procedure incColRow; //增加行列号
begin
if Col = ADataSet.FieldCount - 1 then
begin
Inc(Row);
Col :=0;
end
else
Inc(Col);
end;
procedure WriteStringCell(AValue: string);//写字符串数据
var
L: Word;
begin
L := Length(AValue);
arXlsString[1] := 8 + L;
arXlsString[2] := Row;
arXlsString[3] := Col;
arXlsString[5] := L;
aFileStream.WriteBuffer(arXlsString, SizeOf(arXlsString));
aFileStream.WriteBuffer(Pointer(AValue)^, L);
IncColRow;
end;
procedure WriteIntegerCell(AValue: integer);//写整数
var
V: Integer;
begin
arXlsInteger[2] := Row;
arXlsInteger[3] := Col;
aFileStream.WriteBuffer(arXlsInteger, SizeOf(arXlsInteger));
V := (AValue shl 2) or 2;
aFileStream.WriteBuffer(V, 4);
IncColRow;
end;
procedure WriteFloatCell(AValue: double);//写浮点数
begin
arXlsNumber[2] := Row;
arXlsNumber[3] := Col;
aFileStream.WriteBuffer(arXlsNumber, SizeOf(arXlsNumber));
aFileStream.WriteBuffer(AValue, 8);
IncColRow;
end;
begin
if FileExists(FileName) then DeleteFile(FileName); //文件存在,先删除
aFileStream := TFileStream.Create(FileName, fmCreate);
Try
//写文件头
aFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin));
//写列头
Col := 0; Row := 0;
if bWriteTitle then
begin
for i := 0 to aDataSet.FieldCount - 1 do
WriteStringCell(aDataSet.Fields[i].FieldName);
end;
//写数据集中的数据
aDataSet.DisableControls;
ABookMark := aDataSet.GetBookmark;
aDataSet.First;
while not aDataSet.Eof do
begin
for i := 0 to aDataSet.FieldCount - 1 do
case ADataSet.Fields[i].DataType of
ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
WriteIntegerCell(aDataSet.Fields[i].AsInteger);
ftFloat, ftCurrency, ftBCD:
WriteFloatCell(aDataSet.Fields[i].AsFloat)
else
WriteStringCell(aDataSet.Fields[i].AsString);
end;
aDataSet.Next;
end;
//写文件尾
AFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));
if ADataSet.BookmarkValid(ABookMark) then aDataSet.GotoBookmark(ABookMark);
Finally
AFileStream.Free;
ADataSet.EnableControls;
end;
end;
以上程序,在DELPHI中通过测试!