Delphi編程將數(shù)據(jù)庫數(shù)據(jù)快速導(dǎo)入Excel

在開發(fā)數(shù)據(jù)庫應(yīng)用程序中，經(jīng)常要將類型相同的數(shù)據(jù)導(dǎo)出來，放到Excel文件中，利用Excel強大的編輯功能，對數(shù)據(jù)作進一步的加工處理。這有許多的方法，我們可以使用OLE技術(shù)，在Delphi中創(chuàng)建一個自動化對象，通過該對象來傳送數(shù)據(jù)。也可以使用ADO，通過與Excel數(shù)據(jù)存儲建立連接，使用ADO這種獨立于數(shù)據(jù)庫后端的技術(shù)來導(dǎo)出數(shù)據(jù)集的數(shù)據(jù)。
    可這兩種技術(shù)都有一個共同的缺點，那就是慢，數(shù)據(jù)量少還好，用戶不會有太多的感覺，可一旦數(shù)據(jù)量大，比如，超過1千條，速度就讓人難以忍受了，那么有沒有更好的辦法，既可以快速地導(dǎo)出數(shù)據(jù)，又不用安裝附加的軟件。也許好多人都想到了剪貼板的方式，這種方式速度是快，可也有不好的一面，那就是數(shù)據(jù)量大占用內(nèi)存也大，并且在Excel中調(diào)用PASTE方法時，需要鎖定輸入，這使用起來，就有點不方便了
    這里我為大家介始一種比較好的方法，使用文件流的方式，通過TfileStream直接寫入Excel文件。我寫了一個函數(shù)，通過它可將數(shù)據(jù)集中的數(shù)據(jù)直接導(dǎo)入到Excel文件中。我測試了一下，1M的數(shù)據(jù)，不到十秒就完成了。附源程序。
    首先在你的程序中定義以下幾個數(shù)組：
    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);
    接著調(diào)用下面的函數(shù)。
    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);//寫字符串?dāng)?shù)據(jù)
    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);//寫整數(shù)
    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);//寫浮點數(shù)
    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;
    //寫數(shù)據(jù)集中的數(shù)據(jù)
    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;