Excel generieren ohne Office

[tshubaka]

hallo,
das geht auch ohne Zusatz.

Delphi-Quellcode:

const
{$J+}
  CXlsBof: array[0..5] of Word = ($809, 8, 00, $10, 0, 0);
{$J-}
  CXlsEof: array[0..1] of Word = ($0A, 00);
////////////////////////////////////////////////////////////////////////////////
procedure XlsWriteCellNumber(XlsStream: TStream; const ACol, ARow: Word;
const AValue: Double);
const
{$J+}
  CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
{$J-}
begin
  CXlsNumber[2] := ARow;
  CXlsNumber[3] := ACol;
  XlsStream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber));
  XlsStream.WriteBuffer(AValue, 8);
end;
////////////////////////////////////////////////////////////////////////////////
procedure XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word;
const AValue: string);
var
  L : Word;
const
{$J+}
  CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
{$J-}
begin
  L := Length(AValue);
  CXlsLabel[1] := 8 + L;
  CXlsLabel[2] := ARow;
  CXlsLabel[3] := ACol;
  CXlsLabel[5] := L;
  XlsStream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
  XlsStream.WriteBuffer(Pointer(AValue)^, L);
end;
////////////////////////////////////////////////////////////////////////////////
procedure XlsWriteVal(XLsStream:TStream; Const ERow , ECol :word;Field:TField);
var
  S : String;
  N : Extended;
  D : TDateTime;
Begin
  N := 50000;
  S := '';
  D := 0;
  case field.DataType of
    ftUnknown    : S:='UNKNOWN';
    ftString     : S:=Field.asstring;
    ftSmallint   : N:=Field.asfloat;
    ftInteger    : N:=Field.asfloat;
    ftWord       : N:=Field.asfloat;
    ftBoolean    : S:=Field.asstring;
    ftFloat      : N:=Field.asfloat;
    ftCurrency   : N:=Field.asfloat;
    ftBCD        : N:=Field.asfloat;
    ftDate       : N:=Field.AsFloat;
    ftTime       : N:=Field.AsFloat;
    ftDateTime   : D:=Field.AsDateTime;
    ftBytes      : S:='BYTES';
    ftVarBytes   : S:='VARBYTES';
    ftAutoInc    : N:=Field.asfloat;
    ftBlob       : S:='BLOB';
    ftMemo       : S:=field.AsString;
    ftGraphic    : S:='GRAPHIC';
    ftFmtMemo    : S:='FMTMEMO';
    ftParadoxOle : S:='PARADOXOLE';
    ftDBaseOle   : S:='DBASEOLE';
    ftTypedBinary: S:='TYPEBIN';
    ftCursor     : S:='CURSOR';
    ftFixedChar  : S:=field.asstring;
    ftWideString : S:=field.asstring;
    ftLargeInt   : N:=Field.asfloat;
    ftADT        : S:='ADT';
    ftArray      : S:='ARRAY';
    ftReference  : S:='REFER';
    ftDataSet    : S:='DATASET';
    ftOraBlob    : S:='ORABBLOB ';
    ftOraClob    : S:='ORACCBLOB ';
    ftVariant    : S:=field.asstring;
    ftInterface  : S:='INTERFACE';
    ftIDispatch  : S:='IDISPATCH';
    ftGuid       : S:='GUID';
  end;
  if N <> 50000 then   // auch nuller
     XlsWriteCellNumber(XLsStream, ERow, ECol, N);
  if S <> '' then
     XlsWriteCellLabel(XLsStream, ERow, ECol, S);
  if D <> 0 then
     XlsWriteCellNumber(XLsStream, ERow, ECol, D)
end;
////////////////////////////////////////////////////////////////////////////////
function SaveAsExcelFile(AGrid: TStringGrid; AFileName: string): Boolean;
var
  FStream: TFileStream;
  I, J: Integer;
begin
  Result := False;
  FStream := TFileStream.Create(PChar(AFileName), fmCreate or fmOpenWrite);
  try
    CXlsBof[4] := 0;
    FStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
    for i := 0 to AGrid.ColCount - 1 do
    begin
      for j := 0 to AGrid.RowCount - 1 do
      begin
        try
          XlsWriteCellNumber(FStream, I, J, strtofloat(AGrid.cells[i, j]));
        except
          XlsWriteCellLabel(FStream, I, J, AGrid.cells[i, j]);
        end;
      end;
    end;
    FStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
    Result := True;
  finally
    FStream.Free;
  end;
end;
////////////////////////////////////////////////////////////////////////////////
procedure dbtoXLS(data : TDataset; AFileName : String);
var
  BOOKm : pointer;
  i : integer;
  FStream : TFileStream;
begin
  if not data.active then exit;
  BOOKm:=DATA.GetBookmark;
  data.DisableControls;
  data.first;
  FStream := TFileStream.Create(AFileName, fmCreate);
  try
    CXlsBof[4] := 0;
    FStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
    for i:=0 to Data.FieldCount-1 do
      XlsWriteCellLabel(FStream, i, 0 , data.fields[i].FieldName);
    while not DATA.Eof do
    begin
      for i:=0 to Data.fieldcount-1 do
        XlsWriteVal(FStream,i , data.recno , Data.Fields[i]);
      data.NEXT;
    end;
    FStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
  finally
    data.GotoBookmark(BOOKm);
    data.EnableControls;
    FStream.Free;
  end;
end;

Gruss
Peter