| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 2021 人关注过本帖
标题:Delphi下数据库内容以文件流方式导出EXCEL(无汉字乱码!)
只看楼主 加入收藏
cz012273
Rank: 1
等 级:新手上路
帖 子:9
专家分:0
注 册:2022-4-20
收藏
 问题点数:0 回复次数:3 
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编辑过]

搜索更多相关主题的帖子: 导出 参数 end 文件流 数组 
2022-04-28 19:50
cz012273
Rank: 1
等 级:新手上路
帖 子:9
专家分:0
注 册:2022-4-20
收藏
得分:0 
目前仍有个缺点:未实现多sheet表同时导出。
2022-04-30 05:59
cz012273
Rank: 1
等 级:新手上路
帖 子:9
专家分:0
注 册:2022-4-20
收藏
得分:0 
这两天研究了一下Excel的多sheet表文件格式,还是太复杂,编程实现多表同时导出有难度。其实单表导出最简单的是用csv格式,Excel、Wps表格也都能直接打开。😄
2022-05-01 07:48
Steven_Hu
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2022-5-15
收藏
得分:0 
已阅,谢谢!
2022-05-15 13:14
快速回复:Delphi下数据库内容以文件流方式导出EXCEL(无汉字乱码!)
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.028539 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved