Delphi下数据库内容以文件流方式导出EXCEL（无汉字乱码！）
在Delphi数据库应用程序中，经常要用到将数据库内容导出为EXCEL的功能，为实现这一目的，在网上搜索了一番，发现内容倒是不少，方法也多种多样（如《delphi导出数据至EXCEL的七种方法》，等等，不一一举例。）可是，经过试验，发现大多存在着以下问题：一、普通方法要用到office组件，需要电脑中装有微软office办公套件，这对于经常使用WPS的我来说，不满足；
二、普通方法的导出速度较慢，数据量小的还好说，如果量大一点，等待时间过长，运行起来感觉不好；
三、文件流方式导出速度快，并且不需要安装office软件，这两点都符合我的要求，但唯一一个缺点让我如鲠在喉：导出的EXCEL文件中汉字全部为乱码！这谁能忍得了？！
在多方寻找解决方案无果后，凭着直觉（也许是一点编程经验起的作用吧），我认为是汉字编码上出现的问题。于是我从字符串类型入手，分别尝试将string类型参数修改为utf8string、widestring、ansistring，终于，当参数设置为ansistring的一刹那，电脑屏幕上的一片乱码变成了久违的正常汉字，爽！
为了让其他和我一样有此需求的人不再苦恼，本着互联网开源共享的精神，将本人修改后的代码公之于众，用者自取，不谢！
程序代码：
var
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);
{
以上为导出EXCEL文件格式所需数组变量
}
function ExportDBGrid(FileName: string; bWriteTitle: Boolean; aDataSet: TDataSet): boolean; //函数声明
implementation
{$R *.dfm}
function ExportDBGrid(FileName: string; bWriteTitle: Boolean; aDataSet: TDataSet): boolean;
// 文件流写入方式导出EXCEL
var
i: integer;
Col, row: word;
ABookMark: TBookMark;
aFileStream: TFileStream;
TempFileName, ResultFileName: string;
procedure incColRow; //增加行列号
begin
if Col = ADataSet.FieldCount - 1 then //如果到达末列
begin
Inc(Row); //行加1
Col :=0; //列为0
end
else //如未到末列
Inc(Col); //列加1
end;
procedure WriteStringCell(AValue: ansistring);//写字符串数据
var
L: Word;
begin
L := Length(AValue); //取参数字符串长度
arXlsString[1] := 8 + L; //arXlsString数组元素1：参数串长度+8
arXlsString[2] := Row; //arXlsString数组元素2：行数
arXlsString[3] := Col; //arXlsString数组元素3：列数
arXlsString[5] := L; //arXlsString数组元素5：参数串长度
aFileStream.WriteBuffer(arXlsString, SizeOf(arXlsString)); //arXlsString数组写入文件流
aFileStream.WriteBuffer(Pointer(AValue)^, L); //参数串写入文件流
IncColRow; //增加行列号
end;
procedure WriteIntegerCell(AValue: integer);//写整数
var
V: Integer;
begin
arXlsInteger[2] := Row; //arXlsInteger数组元素2：行数
arXlsInteger[3] := Col; //arXlsInteger数组元素3：列数
aFileStream.WriteBuffer(arXlsInteger, SizeOf(arXlsInteger)); //arXlsInteger数组写入文件流
V := (AValue shl 2) or 2; //整型参数左移2位，然后与2进行or操作，所得值赋给变量V
aFileStream.WriteBuffer(V, 4); //变量V写入文件流（长度为4）
IncColRow; //增加行列号
end;
procedure WriteFloatCell(AValue: double);//写浮点数
begin
arXlsNumber[2] := Row; //arXlsNumber数组元素2：行数
arXlsNumber[3] := Col; //arXlsNumber数组元素3：列数
aFileStream.WriteBuffer(arXlsNumber, SizeOf(arXlsNumber)); //arXlsNumber数组写入文件流
aFileStream.WriteBuffer(AValue, 8); //浮点参数写入文件流，长度为8
IncColRow; //增加行列号
end;
begin
SaveDialog1.DefaultExt := 'xls'; // 默认文件名后缀为xls
SaveDialog1.FileName := FileName; // 读取EXCEL工作簿名称参数
if SaveDialog1.Execute then // 正常调用保存文件对话框
TempFileName := SaveDialog1.FileName // 设定保存文件名
else
begin
result := false;
exit;
end;
ResultFileName := TempFileName; // 确定文件名
if ResultFileName = '' then
ResultFileName := '数据导出';
if FileExists(ResultFileName) then
DeleteFile(PWideChar(WideString(ResultFileName))); //如文件已存在，先删除
aFileStream := TFileStream.Create(ResultFileName, fmCreate); //按照设定文件名创建一个文件
result := True;
Try
//写文件头
aFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin));
//写列头
Col := 0; Row := 0;
if bWriteTitle then //如果列头参数为真
begin
for i := 0 to aDataSet.FieldCount - 1 do //遍历各列
WriteStringCell(ansistring(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(ansistring(aDataSet.Fields[i].AsString)); //调用写字符串过程
end;
aDataSet.Next; //下一记录
end;
//写文件尾
AFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd)); //arXlsEnd数组写入文件流
if ADataSet.BookmarkValid(ABookMark) then //如果原记录定位有效
aDataSet.GotoBookmark(ABookMark); //回到原记录定位
finally
AFileStream.Free; //释放文件流
ADataSet.EnableControls; //连接数据组件（修改完毕）
end;
end;
//函数调用过程
procedure TForm1.Button1Click(Sender: TObject);
begin
ExportDBGrid('导出数据.xls',True,DBGrid1.DataSource.DataSet);
end;
[此贴子已经被作者于2022-4-28 20:05编辑过]
