recordstorage2.pas

一个经典的读写Excel的控件

unit RecordStorage2;

{
********************************************************************************
******* XLSReadWriteII V2.00                                             *******
*******                                                                  *******
******* Copyright(C) 1999,2004 Lars Arvidsson, Axolot Data               *******
*******                                                                  *******
******* email: [e-mail]                                     *******
******* URL:   http://www.axolot.com                                     *******
********************************************************************************
** Users of the XLSReadWriteII component must accept the following            **
** disclaimer of warranty:                                                    **
**                                                                            **
** XLSReadWriteII is supplied as is. The author disclaims all warranties,     **
** expressedor implied, including, without limitation, the warranties of      **
** merchantability and of fitness for any purpose. The author assumes no      **
** liability for damages, direct or consequential, which may result from the  **
** use of XLSReadWriteII.                                                     **
********************************************************************************
}
                        
{$B-}

interface

uses Classes, SysUtils, BIFFRecsII2, XLSStream2;

// Globals
const INTERNAL_PLACEHOLDER = $8000;
const INTERNAL_FORMATS     = $8001;
const INTERNAL_BOUNDSHEETS = $8002;
const INTERNAL_NAMES       = $8003;
const INTERNAL_MSODRWGRP   = $8004;
const INTERNAL_SST         = $8005;

// Worksheet
const INTERNAL_PAGEBREAKES = $8101;
const INTERNAL_HEADER      = $8102;
const INTERNAL_MARGINS     = $8103;
const INTERNAL_COLINFO     = $8104;
const INTERNAL_CELLDATA    = $8105;
const INTERNAL_SUFFIXDATA  = $8106;

type PRecordData = ^TRecordData;
     TRecordData = record
     RecId: word;
     Length: word;
     Index: integer;
     Data: array[0..MAXRECSZ_97] of byte;
     end;

const TRecordData_FixedSz = SizeOf(TRecordData) - MAXRECSZ_97;


type TBaseRecordStorage = class(TList)
private
     function  GetItems(Index: integer): PRecordData;
     procedure SetItems(Index: integer; const Value: PRecordData);
protected
public
     destructor Destroy; override;
     procedure Clear; override;
     function  AddRec(Header: TBIFFHeader; Data: PByteArray): PRecordData;
     procedure ReadUntilEOF(Stream: TXLSStream; PBuf: PByteArray);
     procedure WriteAllRecs(Stream: TXLSStream);
     procedure WriteRec(Index: integer; Stream: TXLSStream);
     function  Size: integer;
     procedure Assign(Records: TBaseRecordStorage);

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

type TRecordStorage = class(TBaseRecordStorage)
private
protected
public
     procedure SetDefaultData; virtual; abstract;
     function  PostCheck: integer; virtual; abstract;
     procedure UpdateDefault(Header: TBIFFHeader; Data: PByteArray); virtual; abstract;
     procedure UpdateInternal(Id: word); virtual; abstract;
     end;

type TRecordStorageDefault = class(TRecordStorage)
protected
     FDefault: TBaseRecordStorage;

     function  AddDefRecWord(Id: integer; Data: word): PRecordData;
     function  AddDefRec(Id,Length: integer): PRecordData;
public
     constructor Create;
     destructor Destroy; override;
     procedure Clear; override;
     procedure MoveDefault(Rec,NewRec: PRecordData); virtual; abstract;
     procedure UpdateRec(var Rec: PRecordData; Header: TBIFFHeader; Data: PByteArray);
     procedure UpdateIntRec(var Rec: PRecordData; Id: word);
     procedure MoveAllDefault;
     end;

type TRecordStorageGlobals = class(TRecordStorageDefault)
private
     P_INT_FORMATS:     PRecordData;
     P_INT_BOUNDSHEETS: PRecordData;
     P_INT_NAMES:       PRecordData;
     P_INT_MSODRWGRP:   PRecordData;
     P_INT_SST:         PRecordData;

     PBOF:              PRecordData;
     PWRITEACCESS:      PRecordData;
     PCODEPAGE:         PRecordData;
     PDSF:              PRecordData;
     PTABID:            PRecordData;
     PFNGROUPCOUNT:     PRecordData;
     PWINDOWPROTECT:    PRecordData;

     PPROTECT:          PRecordData;
     PPASSWORD:         PRecordData;
     PPROT4REV:         PRecordData;

     PWINDOW1:          PRecordData;
     PBACKUP:           PRecordData;
     PHIDEOBJ:          PRecordData;
     P1904:             PRecordData;
     PPRECISION:        PRecordData;
     PREFRESHALL:       PRecordData;
     PBOOKBOOL:         PRecordData;
     PCOUNTRY:          PRecordData;
     PRECALCID:         PRecordData;
     PEOF:              PRecordData;

     function  GetCODEPAGE: word;
     function  GetWINDOW1: PRecWINDOW1;
     function  GetWINDOWPROTECT: boolean;
     function  GetWRITEACCESS: string;
     procedure SetCODEPAGE(const Value: word);
     procedure SetWINDOWPROTECT(const Value: boolean);
     procedure SetWRITEACCESS(const Value: string);
     function  GetBACKUP: boolean;
     procedure SetBACKUP(const Value: boolean);
     function  GetHIDEOBJ: word;
     procedure SetHIDEOBJ(const Value: word);
     function  GetPRECISION: boolean;
     procedure SetRECISION(const Value: boolean);
     function  GetREFRESHALL: boolean;
     procedure SetREFRESHALL(const Value: boolean);
     function  GetBOOKBOOL: boolean;
     procedure SetBOOKBOOL(const Value: boolean);
     function  GetCOUNTRY: PRecCOUNTRY;
     function  GetRECALCID: PRecRECALCID;
     function  GetBOF: PRecBOF8;
protected
public
     constructor Create;
     procedure Clear; override;
     procedure SetDefaultData; override;
     function  PostCheck: integer; override;
     procedure MoveDefault(Rec,NewRec: PRecordData); override;
     procedure UpdateDefault(Header: TBIFFHeader; Data: PByteArray); override;
     procedure UpdateInternal(Id: word); override;

     property BOF: PRecBOF8 read GetBOF;
     property CODEPAGE: word read GetCODEPAGE write SetCODEPAGE;
     property WRITEACCESS: string read GetWRITEACCESS write SetWRITEACCESS;
     property WINDOWPROTECT: boolean read GetWINDOWPROTECT write SetWINDOWPROTECT;
     property WINDOW1: PRecWINDOW1 read GetWINDOW1;
     property BACKUP: boolean read GetBACKUP write SetBACKUP;
     property HIDEOBJ: word read GetHIDEOBJ write SetHIDEOBJ;
     property PRECISION: boolean read GetPRECISION write SetRECISION;
     property REFRESHALL: boolean read GetREFRESHALL write SetREFRESHALL;
     property BOOKBOOL: boolean read GetBOOKBOOL write SetBOOKBOOL;
     property COUNTRY: PRecCOUNTRY read GetCOUNTRY;
     property RECALCID: PRecRECALCID read GetRECALCID;
     end;

type TRecordStorageSheet = class(TRecordStorageDefault)
private
     P_INT_PAGEBREAKES: PRecordData;
     P_INT_HEADER:      PRecordData;
     P_INT_MARGINS:     PRecordData;
     P_INT_COLINFO:     PRecordData;
     P_INT_CELLDATA:    PRecordData;
     P_INT_SUFFIXDATA:  PRecordData;

     PBOF:              PRecordData;
     PCALCMODE:         PRecordData;
     PCALCCOUNT:        PRecordData;
     PDELTA:            PRecordData;
     PREFMODE:          PRecordData;
     PITERATION:        PRecordData;
     PSAVERECALC:       PRecordData;
     PPRINTHEADERS:     PRecordData;
     PPRINTGRIDLINES:   PRecordData;
     PGRIDSET:          PRecordData;
     PGUTS:             PRecordData;
     PDEFAULTROWHEIGHT: PRecordData;
     PWSBOOL:           PRecordData;
     PHCENTER:          PRecordData;
     PVCENTER:          PRecordData;
     PSETUP:            PRecordData;
     PPROTECT:          PRecordData;
     PDEFCOLWIDTH:      PRecordData;
     PDIMENSIONS:       PRecordData;
     PWINDOW2:          PRecordData;
     PSELECTION:        PRecordData;
     PEOF:              PRecordData;
     // Records with index are of variable size, and may need re-allocation.
//     IPLS:              integer;

     function  GetCALCMODE: word;
     procedure SetCALCMODE(const Value: word);
     function  GetDELTA: double;
     procedure SetDELTA(const Value: double);
     function  GetCALCCOUNT: word;
     procedure SetCALCCOUNT(const Value: word);
     function  GetITERATION: boolean;
     function  GetREFMODE: word;
     function  GetSAVERECALC: boolean;
     procedure SetITERATION(const Value: boolean);
     procedure SetREFMODE(const Value: word);
     procedure SetSAVERECALC(const Value: boolean);
     function  GetPRINTGRIDLINES: boolean;
     function  GetPRINTHEADERS: boolean;
     procedure SetPRINTGRIDLINES(const Value: boolean);
     procedure SetPRINTHEADERS(const Value: boolean);
     function  GetGRIDSET: word;
     procedure SetGRIDSET(const Value: word);
     function  GetGUTS: PRecGUTS;
     function  GetDEFAULTROWHEIGHT: PRecDEFAULTROWHEIGHT;
     function  GetWSBOOL: word;
     procedure SetWSBOOL(const Value: word);
     function  GetHCENTER: boolean;
     procedure SetHCENTER(const Value: boolean);
     function  GetVCENTER: boolean;
     procedure SetVCENTER(const Value: boolean);
     function  GetSETUP: PRecSETUP;
     function  GetDEFCOLWIDTH: word;
     procedure SetDEFCOLWIDTH(const Value: word);
     function  GetDIMENSIONS: PRecDIMENSIONS8;
     function  GetWINDOW2: PRecWINDOW2_8;
     function  GetSELECTION: PRecSELECTION;
     function  GetBOF: PRecBOF8;
protected
public
     constructor Create;
     procedure Clear; override;
     procedure SetDefaultData; override;
     function  PostCheck: integer; override;
     procedure MoveDefault(Rec,NewRec: PRecordData); override;
     procedure UpdateDefault(Header: TBIFFHeader; Data: PByteArray); override;
     procedure UpdateInternal(Id: word); override;

     property BOF: PRecBOF8 read GetBOF;
     property CALCMODE: word read GetCALCMODE write SetCALCMODE;
     property CALCCOUNT: word read GetCALCCOUNT write SetCALCCOUNT;
     property DELTA: double read GetDELTA write SetDELTA;
     property REFMODE: word read GetREFMODE write SetREFMODE;
     property ITERATION: boolean read GetITERATION write SetITERATION;
     property SAVERECALC: boolean read GetSAVERECALC write SetSAVERECALC;
     property PRINTHEADERS: boolean read GetPRINTHEADERS write SetPRINTHEADERS;
     property PRINTGRIDLINES: boolean read GetPRINTGRIDLINES write SetPRINTGRIDLINES;
     property GRIDSET: word read GetGRIDSET write SetGRIDSET;
     property GUTS: PRecGUTS read GetGUTS;
     property DEFAULTROWHEIGHT: PRecDEFAULTROWHEIGHT read GetDEFAULTROWHEIGHT;
     property WSBOOL: word read GetWSBOOL write SetWSBOOL;
     property HCENTER: boolean read GetHCENTER write SetHCENTER;
     property VCENTER: boolean read GetVCENTER write SetVCENTER;
//     property PLS: integer read IPLS;
     property SETUP: PRecSETUP read GetSETUP;
     property DEFCOLWIDTH: word read GetDEFCOLWIDTH write SetDEFCOLWIDTH;
     property DIMENSIONS: PRecDIMENSIONS8 read GetDIMENSIONS;
     property WINDOW2: PRecWINDOW2_8 read GetWINDOW2;
     property SELECTION: PRecSELECTION read GetSELECTION;
     end;

implementation

{$ifdef ver130}
type PDouble = ^Double;
{$endif}

{ TBaseRecordStorage }

function TBaseRecordStorage.AddRec(Header: TBIFFHeader; Data: PByteArray): PRecordData;
begin
  GetMem(Result,Header.Length + TRecordData_FixedSz);
  System.Move(Header,Result^,SizeOf(TBIFFHeader));
  System.Move(Data^,Result.Data,Header.Length);
  Result.Index := -1;
  inherited Add(Result);
end;

procedure TBaseRecordStorage.Clear;
var
  i: integer;
begin
  for i := 0 to Count - 1 do begin
    if Items[i] <> Nil then
      FreeMem(inherited Items[i]);
  end;
  inherited Clear;
end;

destructor TBaseRecordStorage.Destroy;
begin
  inherited;
end;

function TBaseRecordStorage.GetItems(Index: integer): PRecordData;
begin
  Result := PRecordData(Inherited Items[Index]);
end;

procedure TBaseRecordStorage.ReadUntilEOF(Stream: TXLSStream; PBuf: PByteArray);
var
  Header: TBIFFHeader;
begin
  while Stream.ReadHeader(Header) = SizeOf(TBIFFHeader) do begin
    Stream.Read(PBuf^,Header.Length);
    AddRec(Header,PBuf);
    if Header.RecId = BIFFRECID_EOF then
      Break;
  end;
end;

procedure TBaseRecordStorage.WriteRec(Index: integer; Stream: TXLSStream);
begin
  Stream.Write(Self[Index].RecId,2);
  Stream.Write(Self[Index].Length,2);
  Stream.Write(Self[Index].Data,Self[Index].Length);
end;

procedure TBaseRecordStorage.WriteAllRecs(Stream: TXLSStream);
var
  i: integer;
begin
  for i := 0 to Count - 1 do
    WriteRec(i,Stream);
end;

procedure TBaseRecordStorage.SetItems(Index: integer; const Value: PRecordData);
begin
  inherited Items[Index] := Value;
end;

// NOTE! Size gives the disk storage size, not the memory used.
function TBaseRecordStorage.Size: integer;
var
  i: integer;
begin
  Result := 0;
  for i := 0 to Count - 1 do
    Inc(Result,SizeOf(TBIFFHeader) + Items[i].Length);
end;

procedure TBaseRecordStorage.Assign(Records: TBaseRecordStorage);
var
  i: integer;
  H: TBIFFHeader;
begin
  for i := 0 to Count - 1 do begin
    H.RecID := Items[i].RecId;
    H.Length := Items[i].Length;
    Records.AddRec(H,@Items[i].Data);
  end;
end;

{ TRecordStorageGlobals }