unit2.pas

利用流快速导出生成EXCEL,5万笔资料只需6秒时间左右

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ADODB, DB;
  
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);

Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean; aDataSet: TDataSet);

implementation

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;

end.