xlsfile3.pas

Advanced Data Import Component Suite for Borland Delphi and C++ Builder allows you to import your da

    property Items[Index: integer]: TbiffBoundSheet read GetItems
      write SetItems; default;
    property Name[Index: integer]: WideString read GetName;
  end;

  TbiffXFList = class(TbiffRecordList)
  private
    function GetItems(Index: integer): TbiffXF;
    procedure SetItems(Index: integer; Value: TbiffXF);
  public
    function Add(Item: TbiffXF): integer;
    procedure Insert(Index: integer; Item: TbiffXF);

    property Items[Index: integer]: TbiffXF read GetItems
      write SetItems; default;
  end;

  TbiffFormatList = class(TbiffRecordList)
  private
    FSorted: boolean;

    function GetItems(Index: integer): TbiffFormat;
    procedure SetItems(Index: integer; Value: TbiffFormat);
    function GetFormat(ID: integer): WideString;
  public
    function Add(Item: TbiffFormat): integer;
    procedure Insert(Index: integer; Item: TbiffFormat);
    function Find(ID: integer; var Index: integer): boolean;
    procedure Sort;

    property Items[Index: integer]: TbiffFormat read GetItems write SetItems;
    property Format[Index: integer]: WideString read GetFormat; default;
  end;

  TbiffSSTList = class(TxlsList)
  private
    function GetItems(Index: integer): TxlsSSTEntry;
    procedure SetItems(Index: integer; Value: TxlsSSTEntry);
  public
    function Add(Item: TxlsSSTEntry): integer;
    procedure Insert(Index: integer; Item: TxlsSSTEntry);
    function Find(Str: TxlsString; var Index: integer): boolean;
    procedure Sort;
    procedure Load(SST: TbiffSST);
    function AddString(const Str: WideString): integer;

    property Items[Index: integer]: TxlsSSTEntry read GetItems write SetItems; default;
  end;

  TxlsRowList = class(TxlsList)
  private
    FSorted: boolean;
    function GetItems(Index: integer): TxlsRow;
    procedure SetItems(Index: integer; Value: TxlsRow);
  public
    constructor Create(Workbook: TxlsWorkbook);
    function Add(Row: TxlsRow): integer;
    procedure Insert(Index: integer; Row: TxlsRow);
    function Find(Row: integer; var Index: integer): boolean;
    procedure Sort;

    property Items[Index: integer]: TxlsRow read GetItems write SetItems; default;
  end;

  TxlsColList = class(TxlsList)
  private
    FSorted: boolean;
    function GetItems(Index: integer): TxlsCol;
    procedure SetItems(Index: integer; Value: TxlsCol);
  public
    constructor Create(Workbook: TxlsWorkbook);
    function Add(Col: TxlsCol): integer;
    procedure Insert(Index: integer; Col: TxlsCol);
    function Find(Col: integer; var Index: integer): boolean;
    procedure Sort;

    property Items[Index: integer]: TxlsCol read GetItems write SetItems; default;
  end;

  TxlsSection = class
  private
    FWorkbook: TxlsWorkbook;
    FBOF: TbiffBOF;
    FEOF: TbiffEOF;

    FOnDestroy: TNotifyEvent;
  public
    constructor Create(Workbook: TxlsWorkbook);
    destructor Destroy; override;
    procedure Load(Stream: TStream; BOF: TbiffBOF); virtual; abstract;
    procedure Clear;

    property Workbook: TxlsWorkbook read FWorkbook;
    property BOF: TbiffBOF read FBOF write FBOF;
    property Eof: TbiffEOF read FEOF write FEOF;

    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
  end;

  TxlsGlobals = class(TxlsSection)
  private
    FBoundSheetList: TbiffBoundSheetList;
    FNameList: TbiffNameList;
    FSSTList: TbiffSSTList;
    FXFList: TbiffXFList;
    FFormatList: TbiffFormatList;

    procedure FixFormats;
  public
    constructor Create(Workbook: TxlsWorkbook);
    destructor Destroy; override;
    procedure Clear;
    procedure Load(Stream: TStream; BOF: TbiffBOF); override;

    property BoundSheetList: TbiffBoundSheetList read FBoundSheetList;
    property NameList: TbiffNameList read FNameList;
    property SSTList: TbiffSSTList read FSSTList;
    property XFList: TbiffXFList read FXFList;
    property FormatList: TbiffFormatList read FFormatList;
  end;

  TxlsSheet = class(TxlsSection)
  private
    FIndex: integer;
    function GetName: WideString;
  public
    constructor Create(Workbook: TxlsWorkbook); virtual;
    property Name: WideString read GetName;
  end;

  TxlsSheetList = class(TxlsList)
  private
    function GetItems(Index: integer): TxlsSheet;
    procedure SetItems(Index: integer; Value: TxlsSheet);
  public
    function Add(Item: TxlsSheet): integer;
    procedure Insert(Index: integer; Item: TxlsSheet);

    property Items[Index: integer]: TxlsSheet read GetItems
      write SetItems; default;
  end;

  TxlsWorkSheet = class(TxlsSheet)
  private
    FRows: TxlsRowList;
    FCols: TxlsColList;
    FShrFmlaList: TbiffShrFmlaList;
    function GetRowCount: integer;
    function GetColCount: integer;
    function GetCells(Row, Col: integer): TbiffCell;
  public
    constructor Create(Workbook: TxlsWorkbook); override;
    destructor Destroy; override;
    procedure Clear;
    procedure Load(Stream: TStream; BOF: TbiffBOF); override;
    procedure AddCell(Cell: TbiffCell);
    procedure AddMultiple(Multiple: TbiffMultiple);
    procedure FixFormulas;

    property Rows: TxlsRowList read FRows;
    property Cols: TxlsColList read FCols;
    property ShrFmlaList: TbiffShrFmlaList read FShrFmlaList;
    property RowCount: integer read GetRowCount;
    property ColCount: integer read GetColCount;
    property Cells[Row, Col: integer]: TbiffCell read GetCells;
  end;

  TxlsWorkSheetList = class(TxlsList)
  private
    function GetItems(Index: integer): TxlsWorkSheet;
    procedure SetItems(Index: integer; Value: TxlsWorkSheet);
    procedure OnDestroyItem(Sender: TObject);
  public
    function Add(Item: TxlsWorkSheet): integer;
    procedure Insert(Index: integer; Item: TxlsWorkSheet);
    function IndexOfName(const Name: WideString): integer;

    property Items[Index: integer]: TxlsWorkSheet read GetItems
      write SetItems; default;
  end;

  TxlsFile = class;

  TxlsWorkbook = class
  private
    FExcelFile: TxlsFile;
    FGlobals: TxlsGlobals;
    FSheets: TxlsSheetList;
    FWorkSheets: TxlsWorkSheetList;
  public
    constructor Create(ExcelFile: TxlsFile);
    destructor Destroy; override;
    procedure Load(Stream: TStream);
    procedure Clear;

    property ExcelFile: TxlsFile read FExcelFile;

    property Globals: TxlsGlobals read FGlobals;
    property Sheets: TxlsSheetList read FSheets;
    property WorkSheets: TxlsWorkSheetList read FWorkSheets;
  end;

//dee  TFunctionEvent = procedure(Sender: TObject; const FunctionName: string;
  TFunctionEvent = procedure(Sender: TObject; const FunctionName: AnsiString;
    Arguments: Variant; var Result: Variant) of object;

  TxlsFile = class
  private
    FFileName: string;
    FStream: TMemoryStream;
    FWorkbook: TxlsWorkbook;
    FLoaded: boolean;

    FOnFunction: TFunctionEvent;

    procedure Open;
    procedure Close;
    procedure OpenStream;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Load;
    procedure Clear;

    property Loaded: boolean read FLoaded;

    property FileName: string read FFileName write FFileName;
    property Workbook: TxlsWorkbook read FWorkbook;

    property OnFunction: TFunctionEvent read FOnFunction write FOnFunction;
  end;

implementation

uses XLSConsts3, XLSUtils3, ComObj, ActiveX, Windows, AxCtrls, Dialogs;

{ TbiffRecord }

constructor TbiffRecord.Create(Section: TxlsSection; ID, DataSize: word;
  Data: PByteArray);
begin
  inherited Create;
  FSection := Section;
  FID := ID;
  FDataSize := DataSize;
  FData := Data;
end;

destructor TbiffRecord.Destroy;
begin
  if Assigned(FOnDestroy) then FOnDestroy(Self);
  if Assigned(FData) then FreeMem(FData);
  if Assigned(FContinue) then begin
    FContinue.Free;
    FContinue := nil;
  end;
  inherited;
end;

procedure TbiffRecord.AddContinue(const Continue: TbiffContinue);
begin
  if Assigned(FContinue) then
    raise ExlsFileError.Create(sInvalidContinue);
  FContinue := Continue;
end;

function TbiffRecord.GetXFList: TbiffXFList;
begin
  Result := Section.Workbook.Globals.XFList;
end;

function TbiffRecord.GetFormatList: TbiffFormatList;
begin
  Result := Section.Workbook.Globals.FormatList;
end;

function TbiffRecord.GetSSTList: TbiffSSTList;
begin
  Result := Section.Workbook.Globals.SSTList;
end;

{ TbiffBOF }

constructor TbiffBOF.Create(Section: TxlsSection; ID, DataSize: word;
  Data: PByteArray);
begin
  inherited;
  if GetWord(Data, 0) <> BIFF_BOF_VER then
    raise Exception.Create(sInvalidVersion);
end;

function TbiffBOF.GetBOFType: word;
begin
  Result := GetWord(Data, 2);
end;

{ TbiffBoundSheet }

function TbiffBoundSheet.GetName: WideString;
var
  Str: TxlsString;
  Offset: integer;
  R: TbiffRecord;
begin
  Offset := 6;
  R := Self;
  Str := TxlsString.CreateR(false, R, Offset);
  try
    Result := Str.Value;
  finally
    Str.Free;
  end;
end;

function TbiffBoundSheet.GetOptionFlags: word;
begin
  Result := GetWord(Data, 4);
end;

{ TbiffString }

function TbiffString.GetValue: WideString;
var
  Str: TxlsString;
  Tmp: TbiffRecord;
  Offset: integer;
begin
  Tmp := Self;
  Offset := 0;
  Str := TxlsString.CreateR(true, Tmp, Offset);
  try
    Result := Str.Value;
  finally
    Str.Free;
  end;
end;

{ TbiffColRow }

constructor TbiffColRow.Create(Section: TxlsSection; ID, DataSize: word;
  Data: PByteArray);
begin
  inherited;
  if DataSize < 4 then
    raise ExlsFileError.CreateFmt(sWrongExcelRecord, [ID]);
end;

function TbiffColRow.GetCol: word;
begin
  Result := GetWord(Data, 2);
end;

procedure TbiffColRow.SetCol(Value: word);
begin
  SetWord(Data, 2, Value);
end;

function TbiffColRow.GetRow: word;
begin
  Result := GetWord(Data, 0);
end;

procedure TbiffColRow.SetRow(Value: word);
begin
  SetWord(Data, 0, Value);
end;

{ TbiffCell }

constructor TbiffCell.Create(Section: TxlsSection; ID, DataSize: word;
  Data: PByteArray); 
begin
  inherited;
  if Section is TxlsWorkSheet
    then FWorkSheet := Section as TxlsWorkSheet
    else FWorkSheet := nil;
end;

function TbiffCell.GetXFIndex: word;
begin
  Result := GetWord(Data, 4);
end;

procedure TbiffCell.SetXFIndex(Value: word);
begin
  SetWord(Data, 4, Value);
end;

function TbiffCell.GetFormatIndex: word;
begin
  Result := Section.Workbook.Globals.XFList[XFIndex].FormatIndex;
end;

function TbiffCell.GetCellName: string;
begin
  Result := Col2Letter(Col) + Row2Number(Row);
end;

function TbiffCell.GetCellType: TbiffCellType;
begin
  Result := bctUnknown;
end;

function TbiffCell.GetIsFormula: boolean;
begin
  Result := false;
end;

function TbiffCell.GetIsString: boolean;
begin
  Result := GetCellType = bctString;
end;

function TbiffCell.GetIsBoolean: boolean;
begin
  Result := GetCellType = bctBoolean;
end;

function TbiffCell.GetIsFloat: boolean;
begin
  Result := GetCellType = bctNumeric;
end;

function TbiffCell.GetIsDateTime: boolean;
begin
  Result := GetCellType = bctDateTime;
end;

function TbiffCell.GetIsDateOnly: boolean;
begin
  Result := (GetCellType = bctDateTime) and (Frac(GetAsDateTime) = 0);
end;

function TbiffCell.GetIsTimeOnly: boolean;
begin
  Result := (GetCellType = bctDateTime) and (Int(GetAsDateTime) = 0);
end;

function TbiffCell.GetIsVariant: boolean;
begin
  Result := GetCellType = bctUnknown;
end;

function TbiffCell.GetAsString: WideString;
begin
  Result := EmptyStr;
end;

procedure TbiffCell.SetAsString(const Value: WideString);
begin
  raise ExlsFileError.CreateFmt(sCellAccessError, [CellName, 'String']);
end;

function TbiffCell.GetAsBoolean: boolean;
begin
  raise ExlsFileError.CreateFmt(sCellAccessError, [CellName, 'Boolean']);
end;

procedure TbiffCell.SetAsBoolean(Value: boolean);
begin
  raise ExlsFileError.CreateFmt(sCellAccessError, [CellName, 'Boolean']);
end;

function TbiffCell.GetAsFloat: double;
begin
  raise ExlsFileError.CreateFmt(sCellAccessError, [CellName, 'Float']);
end;

procedure TbiffCell.SetAsFloat(Value: double);
begin
  raise ExlsFileError.CreateFmt(sCellAccessError, [CellName, 'Float']);
end;

function TbiffCell.GetAsDateTime: TDateTime;
begin
  raise ExlsFileError.CreateFmt(sCellAccessError, [CellName, 'DateTime']);
end;

procedure TbiffCell.SetAsDateTime(Value: TDateTime);
begin
  raise ExlsFileError.CreateFmt(sCellAccessError, [CellName, 'DateTime']);
end;

function TbiffCell.GetAsVariant: variant;
begin
  Result := NULL;
end;

procedure TbiffCell.SetAsVariant(Value: variant);
begin
  raise ExlsFileError.CreateFmt(sCellAccessError, [CellName, 'Variant']);
end;

{ TbiffBoolErr }

function TbiffNumber.GetCellType: TbiffCellType;
begin
  if CellIsDateTime(Self)
    then Result := bctDateTime
    else Result := bctNumeric;
end;

function TbiffBoolErr.GetCellType: TbiffCellType;
begin
  Result := bctBoolean;
end;

function TbiffBoolErr.GetAsBoolean: boolean;
begin
  if Data[6] = 0
    then Result := false
    else Result := true
end;

procedure TbiffBoolErr.SetAsBoolean(Value: boolean);
begin
  Data[7] := 0;
  if Value
    then Data[6] := 1
    else Data[6] := 0;
end;

function TbiffBoolErr.GetAsVariant: variant;
begin
  if Data[7] = 0
    then  Result := GetAsBoolean
    else Result := ErrcodeToString(Data[6]);
end;

procedure TbiffBoolErr.SetAsVariant(Value: variant);
begin
  case VarType(Value) of