Delphi中直接将DataSet中的数据写入Excel文件

Procedure TFormReport.ExportExcelFile(FileName: string; bWriteTitle: Boolean; aDataSet: TClientDataSet);
var
  arXlsBegin: array[0..5] of Word;
  arXlsEnd: array[0..1] of Word;
  arXlsString: array[0..5] of Word;
  arXlsNumber: array[0..4] of Word;
  arXlsInteger: array[0..4] of Word;
  arXlsBlank: array[0..4] of Word;

  i: integer;
  Col, row: word;
  ABookMark: TBookMark;
  aFileStream: TFileStream;
  procedure incColRow; //增加行列号
  begin
    if Col = ADataSet.FieldCount - 1 then begin
      Inc(Row);
      Col :=0;
    end else begin
      Inc(Col);
    end;
  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
  arXlsBegin[0]:=$809;
  arXlsBegin[1]:=8;
  arXlsBegin[2]:=0;
  arXlsBegin[3]:=$10;
  arXlsBegin[4]:=0;
  arXlsBegin[5]:=0;


  arXlsEnd[0]:=$0A;
  arXlsEnd[1]:=00;

  arXlsString[0]:=$204;
  arXlsString[1]:=0;
  arXlsString[2]:=0;
  arXlsString[3]:=0;
  arXlsString[4]:=0;
  arXlsString[5]:=0;

  arXlsNumber[0]:=$203;
  arXlsNumber[1]:=14;
  arXlsNumber[2]:=0;
  arXlsNumber[3]:=0;
  arXlsNumber[4]:=0;

  arXlsInteger[0]:=$27E;
  arXlsInteger[1]:=10;
  arXlsInteger[2]:=0;
  arXlsInteger[3]:=0;
  arXlsInteger[4]:=0;

  arXlsBlank[0]:=$201;
  arXlsBlank[1]:=6;
  arXlsBlank[2]:=0;
  arXlsBlank[3]:=0;
  arXlsBlank[4]:=$17;


  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;