xlsreadii2.pas

一个经典的读写Excel的控件

unit XLSReadII2;

{
********************************************************************************
******* 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-}
{$R-}

interface

uses Classes, SysUtils, Windows, Messages, BIFFRecsII2, CellFormats2, SheetData2,
     XLSStream2, XLSReadWriteII2, XLSUtils2, Dialogs, DecodeFormula2,
     XLSFonts2, ExcelMaskII2, Validate2, Math, XLSRWIIResourceStrings2,
     RecordStorage2, Escher2, MergedCells2;

type TSharedFormula = record
     Row1,Row2: word;
     Col1,Col2: byte;
     Len: word;
     Formula: PByteArray;
     end;

type TXLSReadII = class(TObject)
protected
     PBuf: PByteArray;
     FXLS: TXLSReadWriteII2;
     FCurrSheet: integer;
     FXLSStream: TXLSStream;
     FBoundsheets: TStringList;
     FBoundsheetIndex: integer;
     Header: TBIFFHeader;
     FSharedFormulas: array of TSharedFormula;

     CurrRecs: TRecordStorage;
     InsertRecord: boolean;

     // File prefix
     procedure RREC_FILEPASS;
     procedure RREC_INTERFACEHDR;
     procedure RREC_ADDMENU;
     procedure RREC_DELMENU;
     procedure RREC_INTERFACEEND;
     procedure RREC_WRITEACCESS;
     procedure RREC_CODEPAGE;
     procedure RREC_DSF;
     procedure RREC_FNGROUPCOUNT;
     procedure RREC_WINDOWPROTECT;
     procedure RREC_PROTECT;
     procedure RREC_PASSWORD;
     procedure RREC_PROT4REV;
     procedure RREC_PROT4REVPASS;
     procedure RREC_WINDOW1;
     procedure RREC_BACKUP;
     procedure RREC_HIDEOBJ;
     procedure RREC_1904;
     procedure RREC_PRECISION;
     procedure RREC_REFRESHALL;
     procedure RREC_BOOKBOOL;
     procedure RREC_PALETTE;
     procedure RREC_FONT;
     procedure RREC_FORMAT;
     procedure RREC_XF;
     procedure RREC_STYLE;
     procedure RREC_NAME;
     procedure RREC_SUPBOOK;
     procedure RREC_EXTERNNAME;
     procedure RREC_XCT;
     procedure RREC_EXTERNCOUNT;
     procedure RREC_EXTERNSHEET;
     procedure RREC_USESELFS;
     procedure RREC_BOUNDSHEET;
     procedure RREC_COUNTRY;
     procedure RREC_RECALCID;
     procedure RREC_MSODRAWINGGROUP;
     procedure RREC_SST;
     procedure RREC_EXTSST;
     procedure RREC_EOF;

     // Sheet prefix
     procedure RREC_CALCMODE;
     procedure RREC_CALCCOUNT;
     procedure RREC_REFMODE;
     procedure RREC_ITERATION;
     procedure RREC_DELTA;
     procedure RREC_SAVERECALC;
     procedure RREC_PRINTHEADERS;
     procedure RREC_PRINTGRIDLINES;
     procedure RREC_GRIDSET;
     procedure RREC_GUTS;
     procedure RREC_DEFAULTROWHEIGHT;
     procedure RREC_WSBOOL;
     procedure RREC_HORIZONTALPAGEBREAKS;
     procedure RREC_VERTICALPAGEBREAKS;
     procedure RREC_HEADER;
     procedure RREC_FOOTER;
     procedure RREC_HCENTER;
     procedure RREC_VCENTER;
     procedure RREC_PLS;
     procedure RREC_SETUP;
     procedure RREC_LEFTMARGIN;
     procedure RREC_RIGHTMARGIN;
     procedure RREC_TOPMARGIN;
     procedure RREC_BOTTOMMARGIN;
     procedure RREC_DEFCOLWIDTH;
     procedure RREC_COLINFO;
     procedure RREC_DIMENSIONS;

     // Sheet data
     procedure RREC_INTEGER_20;
     procedure RREC_NUMBER_20;
     procedure RREC_LABEL_20;

     procedure RREC_ROW;
     procedure RREC_BLANK;
     procedure RREC_BOOLERR;
     procedure RREC_FORMULA;
     procedure RREC_FORMULA_30;
     procedure RREC_NUMBER;
     procedure RREC_RK;
     procedure RREC_MULRK;
     procedure RREC_MULBLANK;
     procedure RREC_LABELSST;
     procedure RREC_LABEL;
     procedure RREC_RSTRING;
     procedure RREC_NOTE;

     procedure READ_SHRFMLA;

     // Sheet suffix
     procedure RREC_MSODRAWING;
     procedure RREC_MSODRAWINGSELECTION;
     procedure RREC_WINDOW2;
     procedure RREC_SCL;
     procedure RREC_PANE;
     procedure RREC_SELECTION;
     procedure RREC_DVAL;
     procedure RREC_MERGEDCELLS;
     procedure RREC_CONDFMT;
     procedure RREC_HLINK;

     procedure Clear;
     procedure ClearSharedFmla;
     procedure ReadFormulaVal(Col,Row,FormatIndex: integer; Value: double; Formula: PByteArray; Len: integer);
     procedure FixupSharedFormula(ACol,ARow: integer);
public
     constructor Create(XLS: TXLSReadWriteII2);
     destructor Destroy; override;
     procedure LoadFromStream(Stream: TStream);
     end;


implementation

constructor TXLSReadII.Create(XLS: TXLSReadWriteII2);
begin
  FXLS := XLS;
  FXLSStream := TXLSStream.Create;
  FXLSStream.SaveVBA := XLS.PreserveMacros;
  FBoundsheets := TStringList.Create;
end;

destructor TXLSReadII.Destroy;
begin
  FXLSStream.Free;
  FBoundsheets.Free;
  ClearSharedFmla;
  inherited Destroy;
end;

procedure TXLSReadII.Clear;
begin
  FCurrSheet := -1;
  FBoundsheets.Clear;
  FBoundsheetIndex := -1;
end;

procedure TXLSReadII.ClearSharedFmla;
var
  i: integer;
begin
  for i := 0 to High(FSharedFormulas) do
    FreeMem(FSharedFormulas[i].Formula);
  SetLength(FSharedFormulas,0);
end;

procedure TXLSReadII.LoadFromStream(Stream: TStream);
var
  ProgressCount: integer;
  Count: integer;
  InUSERSVIEW: boolean;
begin
  InUSERSVIEW := False;
  Count := 0;
  Clear;
  FXLS.WriteDefaultData := False;
  try
    FXLSStream.ExtraObjects := FXLS.ExtraObjects;
    FXLSStream.SourceStream := Stream;
    FXLS.Version := FXLSStream.OpenRead(FXLS.Filename);
    GetMem(PBuf,FXLS.MaxBuffsize);

    CurrRecs := FXLS.Records;

    ProgressCount := 0;
    if Assigned(FXLS.OnProgress) then
      FXLS.OnProgress(Self,0);
    try
      while FXLSStream.ReadHeader(Header) = SizeOf(TBIFFHeader) do begin
        if Header.Length > FXLS.MaxBuffsize then begin
          // Invalid record sizer
          FXLSStream.Seek(Header.Length,soFromCurrent);
          Continue;
        end
        else if (Header.RecID and INTERNAL_PLACEHOLDER) <> 0 then
          raise Exception.Create('Bad record in file')
        else if ((Header.RecID and $FF) <> BIFFRECID_BOF) and (Header.RecId <> BIFFRECID_SST) and (Header.RecId <> BIFFRECID_MSODRAWINGGROUP) and (Header.RecId <> BIFFRECID_MSODRAWING) then begin
          FXLSStream.Read(PBuf^,Header.Length);
{
          if FXLSStream.IsEncrypted and (Header.Length > 0) then
            FXLSStream.Decrypt(PBuf,Header.Length);
}
        end;
        Inc(ProgressCount);
        if ProgressCount >= 100 then begin
          if Assigned(FXLS.OnProgress) then
            FXLS.OnProgress(Self,Round((FXLSStream.Pos / FXLSStream.Size) * 100));
          ProgressCount := 0;
        end;

  //      if ((Header.RecID and $FF) <> BIFFRECID_BOF) and (Header.RecID <> BIFFRECID_EXCEL9FILE) then
  //        CurrRecs.Add(Header,PBuf);

        if InUSERSVIEW then begin
          if Header.RecID = BIFFRECID_USERSVIEWEND then
            InUSERSVIEW := False;        
          Continue;
        end;

        InsertRecord := True;
        case Header.RecID of
          BIFFRECID_EOF: begin
            CurrRecs.UpdateDefault(Header,PBuf);
            InsertRecord := False;
            ClearSharedFmla;
            if (FBoundsheets.Count <= 0) or (FBoundsheetIndex >= (FBoundsheets.Count - 1)) then begin
              Break;
            end;
          end;
          // File prefix
  //        BIFFRECID_OBPROJ:              InsertRecord := False;
          BIFFRECID_EXCEL9FILE:          InsertRecord := False;
          BIFFRECID_FILEPASS:            RREC_FILEPASS;
          BIFFRECID_INTERFACEHDR:        RREC_INTERFACEHDR;
          BIFFRECID_INTERFACEEND:        RREC_INTERFACEEND;
          BIFFRECID_WRITEACCESS:         RREC_WRITEACCESS;
          BIFFRECID_CODEPAGE:            RREC_CODEPAGE;
          BIFFRECID_DSF:                 RREC_DSF;
          BIFFRECID_FNGROUPCOUNT:        RREC_FNGROUPCOUNT;

          BIFFRECID_WINDOWPROTECT:       RREC_WINDOWPROTECT;
          BIFFRECID_PROTECT:             RREC_PROTECT;
          BIFFRECID_PASSWORD:            RREC_PASSWORD;
          BIFFRECID_PROT4REV:            RREC_PROT4REV;
          BIFFRECID_PROT4REVPASS:        RREC_PROT4REVPASS;

          BIFFRECID_WINDOW1:             RREC_WINDOW1;
          BIFFRECID_BACKUP:              RREC_BACKUP;
          BIFFRECID_HIDEOBJ:             RREC_HIDEOBJ;
          BIFFRECID_1904:                RREC_1904;
          BIFFRECID_PRECISION:           RREC_PRECISION;
          BIFFRECID_REFRESHALL:          RREC_REFRESHALL;
          BIFFRECID_BOOKBOOL:            RREC_BOOKBOOL;
          BIFFRECID_PALETTE:             RREC_PALETTE;

          BIFFRECID_FONT,$0231:          RREC_FONT;
          BIFFRECID_FORMAT:              RREC_FORMAT;
          BIFFRECID_XF_30,
          BIFFRECID_XF_40,
          BIFFRECID_XF:                  RREC_XF;

          // STYLE (inbyggda) m錽te finnas, annars s