xlsfile3.pas

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

unit XLSFile3;

{$I QImport3VerCtrl.Inc}

interface

uses Classes, SysUtils {$IFDEF VCL6}, Variants{$ENDIF}, XLSCommon3;

type
  TxlsSection = class;
  TbiffXFList = class;
  TbiffFormatList = class;
  TbiffSSTList = class;

  TbiffContinue = class;

  TbiffRecord = class
  private
    FSection: TxlsSection;
    FID: word;
    FDataSize: word;
    FData: PByteArray;
    FContinue: TbiffContinue;
    FOnDestroy: TNotifyEvent;

    function GetXFList: TbiffXFList;
    function GetFormatList: TbiffFormatList;
    function GetSSTList: TbiffSSTList;
  public
    constructor Create(Section: TxlsSection; ID, DataSize: word;
      Data: PByteArray); virtual;
    destructor Destroy; override;
    procedure AddContinue(const Continue: TbiffContinue);

    property Section: TxlsSection read FSection;
    property XFList: TbiffXFList read GetXFList;
    property FormatList: TbiffFormatList read GetFormatList;
    property SSTList: TbiffSSTList read GetSSTList;

    property ID: word read FID;
    property DataSize: word read FDataSize write FDataSize;
    property Data: PByteArray read FData;

    property Continue: TbiffContinue read FContinue;

    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
  end;

  TbiffContinue = class(TbiffRecord);

  TbiffBOF = class(TbiffRecord)
  private
    function GetBOFType: word;
  public
    property BOFType: word read GetBOFType;
    constructor Create(Section: TxlsSection; ID, DataSize: word;
      Data: PByteArray); override;
  end;

  TbiffEOF = class(TbiffRecord);

  TbiffBoundSheet = class(TbiffRecord)
  private
    function GetName: WideString;
    function GetOptionFlags: word;
  public
    property Name: WideString read GetName;
    property OptionFlags: word read GetOptionFlags;
  end;

  TbiffString = class(TbiffRecord)
  private
    function GetValue: WideString;
  public
    property Value: WideString read GetValue;
  end;

  TbiffColRow = class(TbiffRecord)
  private
    function GetCol: word;
    procedure SetCol(Value: word);
    function GetRow: word;
    procedure SetRow(Value: word);
  public
    constructor Create(Section: TxlsSection; ID, DataSize: word;
      Data: PByteArray); override;

    property Col: word read GetCol write SetCol;
    property Row: word read GetRow write SetRow;
  end;

  TbiffCellType = (bctString, bctBoolean, bctNumeric, bctDateTime, bctUnknown);

  TxlsWorkSheet = class;

  TbiffCell = class(TbiffColRow)
  private
    FWorkSheet: TxlsWorkSheet;
    function GetXFIndex: word;
    procedure SetXFIndex(Value: word);
    function GetFormatIndex: word;
    function GetCellName: string;
  protected
    function GetCellType: TbiffCellType; virtual;
    function GetIsFormula: boolean; virtual;
    function GetIsString: boolean;
    function GetIsBoolean: boolean;
    function GetIsFloat: boolean;
    function GetIsDateTime: boolean;
    function GetIsDateOnly: boolean;
    function GetIsTimeOnly: boolean;
    function GetIsVariant: boolean;
    function GetAsString: WideString; virtual;
    procedure SetAsString(const Value: WideString); virtual;
    function GetAsBoolean: boolean; virtual;
    procedure SetAsBoolean(Value: boolean); virtual;
    function GetAsFloat: double; virtual;
    procedure SetAsFloat(Value: double); virtual;
    function GetAsDateTime: TDateTime; virtual;
    procedure SetAsDateTime(Value: TDateTime); virtual;
    function GetAsVariant: variant; virtual;
    procedure SetAsVariant(Value: variant); virtual;
  public
    constructor Create(Section: TxlsSection; ID, DataSize: word;
      Data: PByteArray); override;

    property WorkSheet: TxlsWorkSheet read FWorkSheet;
    property XFIndex: word read GetXFIndex write SetXFIndex;
    property FormatIndex: word read GetFormatIndex;

    property CellType: TbiffCellType read GetCellType;

    property IsFormula: boolean read GetIsFormula;
    property IsString: boolean read GetIsString;
    property IsBoolean: boolean read GetIsBoolean;
    property IsFloat: boolean read GetIsFloat;
    property IsDateTime: boolean read GetIsDateTime;
    property IsDateOnly: boolean read GetIsDateOnly;
    property IsTimeOnly: boolean read GetIsTimeOnly;
    property IsVariant: boolean read GetIsVariant;

    property AsString: WideString read GetAsString write SetAsString;
    property AsBoolean: boolean read GetAsBoolean write SetAsBoolean;
    property AsFloat: double read GetAsFloat write SetAsFloat;
    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
    property AsVariant: variant read GetAsVariant write SetAsVariant;
    property Value: variant read GetAsVariant write SetAsVariant;
    property CellName: string read GetCellName;
  end;

  TbiffBlank = class(TbiffCell);

  TbiffBoolErr = class(TbiffCell)
  protected
    function GetCellType: TbiffCellType; override;

    function GetAsBoolean: boolean; override;
    procedure SetAsBoolean(Value: boolean); override;
    function GetAsVariant: variant; override;
    procedure SetAsVariant(Value: variant); override;
    function GetAsString: WideString; override;
    procedure SetAsString(const Value: WideString); override;
  end;

  TbiffNumber = class(TbiffCell)
  protected
    function GetCellType: TbiffCellType; override;

    function GetAsFloat: double; override;
    procedure SetAsFloat(Value: double); override;
    function GetAsDateTime: TDateTime; override;
    procedure SetAsDateTime(Value: TDateTime); override;
    function GetAsVariant: variant; override;
    procedure SetAsVariant(Value: variant); override;
    function GetAsString: WideString; override;
    procedure SetAsString(const Value: WideString); override;
  end;

  TbiffRK = class(TbiffCell)
  protected
    function GetCellType: TbiffCellType; override;

    function GetAsFloat: double; override;
    procedure SetAsFloat(Value: double); override;
    function GetAsDateTime: TDateTime; override;
    procedure SetAsDateTime(Value: TDateTime); override;
    function GetAsVariant: variant; override;
    procedure SetAsVariant(Value: variant); override;
    function GetAsString: WideString; override;
    procedure SetAsString(const Value: WideString); override;
  end;

  TxlsCharSize = 1..2;

  TxlsString = class
    FIsWideStr: boolean;

    FStrLen: word;
    FOptionFlags: byte;
    FWideData: WideString;
//dee    FShortData: string;
    FShortData: AnsiString;

    FRTFNumber: word;
    FRTFData: PByteArray;
//dee    FFarEastDataSize: word;
    FFarEastDataSize: Longword;
    FFarEastData: PByteArray;

    function GetLenOfLen: byte;
    function GetHasWideChar: boolean;
    function GetHasRichText: boolean;
    function GetFarEast: boolean;
    function GetValue: WideString;
  public
    constructor CreateR(IsWideStr: boolean; var ARecord: TbiffRecord;
      var Offset: integer);
    constructor CreateWS(IsWideStr: boolean; const Str: WideString);
    function Compare(Str: TxlsString): integer; //-1 if less, 0 if equal, 1 if more

    property OptionFlags: byte read FOptionFlags;
//dee  property ShortData: string read FShortData;
    property ShortData: AnsiString read FShortData;
    property WideData: WideString read FWideData;

    property LenOfLen: byte read GetLenOfLen;
    property HasWideChar: boolean read GetHasWideChar;
    property HasRichText: boolean read GetHasRichText;
    property HasFarEast: boolean read GetFarEast;
    property Value: WideString read GetValue;
  end;

  TxlsSSTEntry = class
  private
    FRefCount: integer;
    FValue: TxlsString;
    FOnDestroy: TNotifyEvent;
  public
    constructor CreateXS(Str: TxlsString);
    constructor CreateWS(Str: WideString);
    destructor Destroy; override;

    procedure IncRef;
    procedure DecRef;

    property RefCount: integer read FRefCount;
    property Value: TxlsString read FValue;

    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
  end;

  TbiffLabelSST = class(TbiffCell)
  private
    FSSTEntry: TxlsSSTEntry;
    procedure DestroySSTEntry(Sender: TObject);
  protected
    function GetCellType: TbiffCellType; override;

    function GetAsString: WideString; override;
    procedure SetAsString(const Value: WideString); override;
    function GetAsVariant: variant; override;
    procedure SetAsVariant(Value: variant); override;
  public
    constructor Create(Section: TxlsSection; ID, DataSize: word;
      Data: PByteArray); override;
    destructor Destroy; override;
  end;

  ETokenException = class(Exception)
  private
    FToken: integer;
  public
    constructor Create(Token: integer);
    property Token: integer read FToken;
  end;

  TbiffFormula = class(TbiffCell)
  private
    FValue: variant;

    function GetIsExp: boolean;
    function GetKey: cardinal;

    procedure ArrangeSharedFormulas;
  protected
    function GetIsFormula: boolean; override;
    function GetAsVariant: variant; override;
    procedure SetAsVariant(Value: variant); override;
    function GetAsString: WideString; override;
    procedure SetAsString(const Value: WideString); override;
  public
    constructor Create(Section: TxlsSection; ID, DataSize: word;
      Data: PByteArray); override;
    procedure MixShared(SharedData: PByteArray; SharedDataSize: integer);

    property IsExp: boolean read GetIsExp;
    property Key: cardinal read GetKey;
  end;

  TbiffShrFmla = class(TbiffRecord)
  private
    function GetFirstRow: word;
    function GetLastRow: word;
    function GetFirstCol: word;
    function GetLastCol: word;
    function GetKey: integer;
  public
    property FirstRow: word read GetFirstRow;
    property LastRow: word read GetLastRow;
    property FirstCol: word read GetFirstCol;
    property LastCol: word read GetLastCol;
    property Key: integer read GetKey;
  end;

  TbiffName = class(TbiffRecord)
  private
    function GetName: WideString;
    function GetNameLength: byte;
    function GetNameSize: integer;
    function GetOptionFlags: byte;
    function GetRow1: integer;
    function GetRow2: integer;
    function GetCol1: integer;
    function GetCol2: integer;
  public
    property Name: WideString read GetName;
    property NameLength: byte read GetNameLength;
    property NameSize: integer read GetNameSize;
    property OptionFlags: byte read GetOptionFlags;
    property Row1: integer read GetRow1;
    property Row2: integer read GetRow2;
    property Col1: integer read GetCol1;
    property Col2: integer read GetCol2;
  end;

  TbiffMultiple = class(TbiffRecord)
  protected
    FCol: integer;
    function GetEOF: boolean; virtual; abstract;
    function GetCell: TbiffCell; virtual; abstract;
  public
    constructor Create(Section: TxlsSection; ID, DataSize: word;
      Data: PByteArray); override;
    property Eof: boolean read GetEOF;
    property Cell: TbiffCell read GetCell;
  end;

  TbiffMulBlank = class(TbiffMultiple)
  protected
    function GetEOF: boolean; override;
    function GetCell: TbiffCell; override;
  end;

  TbiffMulRK = class(TbiffMultiple)
  protected
    function GetEOF: boolean; override;
    function GetCell: TbiffCell; override;
  end;

  TbiffFont = class(TbiffRecord);

  TbiffXF = class(TbiffRecord)
  private
    function GetFormatIndex: word;
    procedure SetFormatIndex(Value: word);
  public
    property FormatIndex: word read GetFormatIndex
      write SetFormatIndex;
  end;

  TbiffFormat = class(TbiffRecord)
  private
    FID: word;
    FValue: WideString;
  public
    constructor Create(Section: TxlsSection; ID, DataSize: word;
      Data: PByteArray); override;

    property ID: word read FID;
    property Value: WideString read FValue;
  end;

  TbiffSST = class(TbiffRecord)
  private
    FCount: integer;
  public
    property Count: integer read FCount;
    constructor Create(Section: TxlsSection; ID, DataSize: word;
      Data: PByteArray); override;
  end;

  TxlsWorkbook = class;

  TxlsList = class(TList)
  private
    FWorkbook: TxlsWorkbook;
    function GetItems(Index: integer): TObject;
    procedure SetItems(Index: integer; Value: TObject);
  public
    function Add(Item: TObject): integer;
    constructor Create(Workbook: TxlsWorkbook);
    procedure Delete(Index: integer);
    {$IFDEF VCL5}
    function Extract(Item: TObject): TObject;
    {$ENDIF}
    function First: TObject;
    function IndexOf(Item: TObject): integer;
    procedure Insert(Index: integer; Item: TObject);
    function Last: TObject;
    function Remove(Item: TObject): integer;

    property Items[Index: integer]: TObject read GetItems write SetItems;
    property Workbook: TxlsWorkbook read FWorkbook;
  end;

  TbiffRecordList = class(TxlsList)
  private
    FTotalSize: integer;
    function GetItems(Index: integer): TbiffRecord;
    procedure SetItems(Index: integer; Value: TbiffRecord);
  public
    function Add(Item: TbiffRecord): integer;
    procedure Insert(Index: integer; Item: TbiffRecord);
    procedure CorrectSize(Delta: integer);
    procedure RecalculateTotalSize;

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

  TbiffColRowList = class(TbiffRecordList)
  private
    function GetItems(Index: integer): TbiffColRow;
    procedure SetItems(Index: integer; Value: TbiffColRow);
  public
    property Items[Index: integer]: TbiffColRow read GetItems write SetItems; default;
    function Add(Item: TbiffColRow): integer;
    procedure Insert(Index: integer; Item: TbiffColRow);
  end;

  TbiffColRowListClass = class of TbiffColRowList;

  TbiffCellList = class(TbiffColRowList)
  private
    FSorted: boolean;
    function GetItems(Index: integer): TbiffCell;
    procedure SetItems(Index: integer; Value: TbiffCell);
    procedure OnDestroyItem(Sender: TObject);
  protected
    procedure SetMinAndMaxCells(Item: TbiffCell); virtual;
    procedure SetColRowNumber(Item: TbiffCell); virtual;
    property Sorted: boolean read FSorted write FSorted;
  public
    function Add(Item: TbiffCell): integer;
    procedure Insert(Index: integer; Item: TbiffCell);

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

  TxlsRow = class(TbiffCellList)
  private
    FRowNumber: integer;
    FMinCol: integer;
    FMaxCol: integer;
  protected
    procedure SetMinAndMaxCells(Item: TbiffCell); override;
    procedure SetColRowNumber(Item: TbiffCell); override;
  public
    constructor Create(Workbook: TxlsWorkbook);
    function Find(Col: integer; var Index: integer): boolean;
    procedure Sort;

    property RowNumber: integer read FRowNumber;
    property MinCol: integer read FMinCol;
    property MaxCol: integer read FMaxCol;
  end;

  TxlsCol = class(TbiffCellList)
  private
    FColNumber: integer;
    FMinRow: integer;
    FMaxRow: integer;
  protected
    procedure SetMinAndMaxCells(Item: TbiffCell); override;
    procedure SetColRowNumber(Item: TbiffCell); override;
  public
    constructor Create(Workbook: TxlsWorkbook);
    function Find(Row: integer; var Index: integer): boolean;
    procedure Sort;

    property ColNumber: integer read FColNumber;
    property MinRow: integer read FMinRow;
    property MaxRow: integer read FMaxRow;
  end;

  TbiffShrFmlaList = class(TbiffRecordList)
  private
    FSorted: boolean;

    function GetItems(Index: integer): TbiffShrFmla;
    procedure SetItems(Index: integer; Value: TbiffShrFmla);
  public
    function Add(Item: TbiffShrFmla): integer;
    procedure Insert(Index: integer; Item: TbiffShrFmla);
    function Find(Key: integer; var Index: integer): boolean;
    procedure Sort;

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

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

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

  TbiffBoundSheetList = class(TbiffRecordList)
  private
    function GetItems(Index: integer): TbiffBoundSheet;
    procedure SetItems(Index: integer; Value: TbiffBoundSheet);
    function GetName(Index: integer): WideString;
  public
    function Add(Item: TbiffBoundSheet): integer;
    procedure Insert(Index: integer; Item: TbiffBoundSheet);