Delphi數據庫數據用文件流方式快速寫入Excel文件

 

在開發數據庫應用程序中，經常要將類型相同的數據導出來，放到Excel文件中，利用Excel強大的編輯功能，對數據作進一步的加工處理。這有許多的方法，我們可以使用OLE技術，在Delphi中創建一個自動化對象，通過該對象來傳送數據。也可以使用ADO，通過與Excel數據存儲建立連接，使用ADO這種獨立於數據庫后端的技術來導出數據集的數據。

可這兩種技術都有一個共同的缺點，那就是慢，數據量少還好，用戶不會有太多的感覺，可一旦數據量大，比如，超過1千條，速度就讓人難以忍受了，那么有沒有更好的辦法，既可以快速地導出數據，又不用安裝附加的軟件。也許好多人都想到了剪貼板的方式，這種方式速度是快，可也有不好的一面，那就是數據量大占用內存也大，並且在Excel中調用PASTE方法時，需要鎖定輸入，這使用起來，就有點不方便了

這里我為大家介始一種比較好的方法，使用文件流的方式，通過TfileStream直接寫入Excel文件。我寫了一個函數，通過它可將數據集中的數據直接導入到Excel文件中。我測試了一下，1M的數據，不到十秒就完成了。附源程序。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,DB, ADODB, Grids, DBGrids, StdCtrls;

type  
  TForm1 = class(TForm)
    DBGrid1: TDBGrid;
    ADOTable1: TADOTable;
    DataSource1: TDataSource;
    ADOConnection1: TADOConnection;
    ADOTable1record_id: TIntegerField;
    ADOTable1action_id: TIntegerField;
    ADOTable1action_name: TStringField;
    ADOTable1net_name: TStringField;
    ADOTable1deal_no: TStringField;
    ADOTable1name: TStringField;
    ADOTable1getno_date: TDateTimeField;
    ADOTable1window_no: TIntegerField;
    ADOTable1staff_id: TStringField;
    ADOTable1staff_name: TStringField;
    ADOTable1deal_date: TDateTimeField;
    ADOTable1deal_type: TStringField;
    ADOTable1finish_date: TDateTimeField;
    ADOTable1state: TStringField;
    ADOTable1appraise: TStringField;
    ADOTable1appraised_flag: TBooleanField;
    ADOTable1cancel_led_time: TDateTimeField;
    ADOTable1wait_time: TBCDField;
    ADOTable1wait_time2: TStringField;
    ADOTable1accept_time: TBCDField;
    ADOTable1accept_time2: TStringField;
    ADOTable1getnumber_addr: TIntegerField;
    ADOTable1cust_level: TIntegerField;
    ADOTable1cust_level_name: TStringField;
    ADOTable1cust_level_name_remark: TStringField;
    ADOTable1operation_sum: TIntegerField;
    Button1: TButton;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  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);
implementation

{$R *.dfm}

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;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
  begin
    ExportExcelFile(SaveDialog1.FileName,True,DBGrid1.DataSource.DataSet);
  end;  
end;

end.