unit uXLSExcelDateiClass;
{
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Unit: uXLSExcelDateiClass
letz.Ändr.: 01.05.2009
Version: 1.00 // abgespeckte Version für die DP
Funktion: Die Daten von TDataSet werden in einer Excel-Datei (.XLS) ab-
gespeichert.
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
}
interface
uses
Classes, SysUtils,
DB, Variants, Messages, Dialogs;
const
XLS_WORKSSHEET= $10;
XLS_BOF = $809;
XLS_BIFFVER = $600;
XLS_LABEL = $204;
XLS_EOF = $A0;
XLS_EXCEL_VERSION = 1;
type
TXLS_BOFRec=
packed record // Start des Datenblockes
RecCode: Word;
// $809 BOF
RecLaenge: Word;
// Record Länge // Komplett 16/ normal 8
BIFFVersion: Word;
// $ 600 BiffVersions-Nummer:8
Bereich: Word;
// $10 = Workssheet
ExcelVersion: Word;
// muss nicht angegeben werden 2719=Excel 2000
ExcelDatum: Word;
// muss nicht angegeben werden
end;
TXLS_LABELRec=
packed record // String-Record von Excel
RecCode: Word;
// $204 Bei Biff 8
RecLaenge: Word;
// Record Länge // muss zuvor berechnet werden
Row: Word;
// Zeilen-Nr. beginnt bei 0
Col: Word;
// Spalten-Nr. beginnt bei 0
IndexXFRec: Word;
// noch nicht ganz verstanden // erstmal=0
ZellenStLeange: Word;
// Nur die ZellenString-Länge
end;
TXLS_EOFRec=
packed record // Ende des Datenblockes
RecCode: Word;
// $A0
RecLaenge: Word;
// 00 hat immer die Länge = 0
end;
type
TXLS_DateiClass=
Class(TObject)
private
FXLSDateiName: TFileName;
FXLSDataSet: TDataSet;
FBOF: TXLS_BOFRec;
FEOF: TXLS_EOFRec;
FLABEL: TXLS_LABELRec;
procedure XLS_BOFRecDatenFuellen;
procedure XLS_EOFRecDatenFuellen;
procedure XLS_LABELRecDatenFuellen(
const Zeile, Spalte: Word;
aWert:
String);
procedure getFXLSDateiName(
const Value: TFileName);
function setFXLSDateiName: TFileName;
procedure getFXLSDataSet(
const Value: TDataSet);
function setFXLSDataSet: TDataSet;
public
Constructor Create();
destructor Destroy;
override;
property XLSDateiName: TFileName
read setFXLSDateiName
write getFXLSDateiName;
property XLSDataSet: TDataSet
read setFXLSDataSet
write getFXLSDataSet;
procedure XLS_DateiErstellen;
End;
implementation
{ XLS_DateiClass }
constructor TXLS_DateiClass.Create();
begin
inherited Create;
XLS_BOFRecDatenFuellen;
// XLS-Datei Anfang schreiben
XLS_EOFRecDatenFuellen;
// XLS-Datein Ende schreiben
end;
destructor TXLS_DateiClass.Destroy;
begin
inherited Destroy;
end;
procedure TXLS_DateiClass.getFXLSDataSet(
const Value: TDataSet);
begin
if Value<>FXLSDataSet
then
begin
FXLSDataSet:= Value;
end;
end;
procedure TXLS_DateiClass.getFXLSDateiName(
const Value: TFileName);
begin
if Value<> FXLSDateiName
then
begin
FXLSDateiName:= Value;
end;
end;
function TXLS_DateiClass.setFXLSDataSet: TDataSet;
begin
result:= FXLSDataSet;
end;
function TXLS_DateiClass.setFXLSDateiName: TFileName;
begin
Result:= XLSDateiName;
end;
procedure TXLS_DateiClass.XLS_BOFRecDatenFuellen;
begin
with FBOF
do
begin
RecCode:= XLS_BOF ;
RecLaenge:= 8;
BIFFVersion:= 1;
// Kann auch 1 sein // später XLS_BIFFVER = $600;
Bereich:= XLS_WORKSSHEET;
ExcelVersion:= 1;
ExcelDatum:= 0;
end;
end;
procedure TXLS_DateiClass.XLS_DateiErstellen;
var
XLSFileStream: TFileStream;
I, x: Integer;
TempStr:
String;
begin
if ((
not (FXLSDateiName = '
'))
and (
not (FXLSDataSet =
NIL)))
then
begin
XLSFileStream:= TFileStream.Create(FXLSDateiName, fmCreate);
try
// XLS-File Anfang schreiben
XLSFileStream.WriteBuffer(FBOF, sizeOf(FBOF));
// Feldernamen setzen
for I := 0
to FXLSDataSet.FieldCount-1
do
begin
TempStr:= VarToStr(FXLSDataSet.Fields[i].FieldName);
XLS_LABELRecDatenFuellen(0, i, TempStr);
XLSFileStream.WriteBuffer(FLABEL, sizeOf(FLABEL));
XLSFileStream.WriteBuffer(TempStr[1], Length(TempStr));
end;
// Daten in XLS-File schreiben
x:= 1;
while not FXLSDataSet.EOF
do
begin
for I := 0
to FXLSDataSet.FieldCount-1
do
begin
TempStr:= VarToStr(FXLSDataSet.Fields[i].Value);
XLS_LABELRecDatenFuellen(x, i, TempStr);
XLSFileStream.WriteBuffer(FLABEL, sizeOf(FLABEL));
XLSFileStream.WriteBuffer(TempStr[1], Length(TempStr));
end;
inc(x);
FXLSDataSet.Next;
end;
// XLS-File Ende schreiben
XLSFileStream.WriteBuffer(FEOF, sizeOf(FEOF));
finally
XLSFileStream.Free;
end;
end else
begin
ShowMessage('
Fehlende Angaben bei der XLS-File Erstellung!');
end;
end;
procedure TXLS_DateiClass.XLS_EOFRecDatenFuellen;
begin
with FEOF
do
begin
RecCode:= $A;
RecLaenge:= 0;
end;
end;
procedure TXLS_DateiClass.XLS_LABELRecDatenFuellen(
const Zeile, Spalte: Word;
aWert:
String);
begin
with FLABEL
do
begin
RecCode:= XLS_LABEL;
RecLaenge:= 8 + Length(aWert);
Row:= Zeile;
Col:= Spalte;
IndexXFRec:= 0;
ZellenStLeange:= Length(aWert);
// Länge vom String eintragen
end;
end;
end.