tmsuxlsbaserecords.pas

TMS Component Pack V5.0包含了超过 280 个为 Delphi 以及 C++Builder 设计的 TMS 生产控件

  begin
    aPos:=0;
    aRecord:=aRecord.Continue;
    if aRecord=nil then raise Exception.Create(ErrReadingRecord);
  end;

  l:= aRecord.DataSize-aPos;

  if aSize<=l then
  begin
    if pResult<>nil then Move(aRecord.Data^[aPos], pResult^, aSize);
    inc(aPos, aSize);
  end else
  begin
    ReadMem(aRecord, aPos, l, pResult);
    if pResult<>nil then ReadMem(aRecord, aPos, aSize-l, PAddress(pResult)+ l)
    else ReadMem(aRecord, aPos, aSize-l, nil);
  end
end;

procedure ReadStr(var aRecord: TBaseRecord; var aPos: integer; var ShortData: AnsiString; var WideData: UTF16String; var OptionFlags, ActualOptionFlags: byte; var DestPos: integer; const StrLen: integer );
//Read a string taking in count "Continue" Records
var
  l,i: integer;
  pResult: pointer;
  aSize, CharSize: integer;
begin
  l:= aRecord.DataSize-aPos;

  if l<0 then raise Exception.Create(ErrReadingRecord);
  if (l=0) and (StrLen>0) then
  // This is not a valid Excel thing, but if it is (f.i. on JET exported files), the optionflags will be repeated.
    {if DestPos=0 then  //we are beginning the record
    begin
      aPos:=0;
      if aRecord.Continue=nil then raise Exception.Create(ErrReadingRecord);
      aRecord:=aRecord.Continue;
    end else }
    begin       //We are in the middle of a string
      aPos:=1;
      if aRecord.Continue=nil then raise Exception.Create(ErrReadingRecord);
      aRecord:=aRecord.Continue;
      ActualOptionFlags:=aRecord.Data[0];
      if (ActualOptionFlags=1) and ((OptionFlags and 1)=0 ) then
      begin
        WideData:=StringToWideStringNoCodePage(ShortData);
        OptionFlags:= OptionFlags or 1;
      end;
    end;

  l:= aRecord.DataSize-aPos;

  if (ActualOptionFlags and 1)=0 then
  begin
    aSize:= StrLen-DestPos;
    pResult:= @ShortData[DestPos+1];
    CharSize:=1;
  end else
  begin
    aSize:= (StrLen-DestPos)*2;
    pResult:= @WideData[DestPos+1];
    CharSize:=2;
  end;

  if aSize<=l then
  begin
    if (ActualOptionFlags and 1=0) and (OptionFlags and 1=1) then
      //We have to move result to widedata
      for i:=0 to aSize div CharSize -1 do WideData[DestPos+1+i]:=UTF16Char(aRecord.Data^[aPos+i])
      //We are either reading widedata or shortdata
      else Move(aRecord.Data^[aPos], pResult^, aSize);

    inc(aPos, aSize);
    inc(DestPos, aSize div CharSize);
  end else
  begin
    if (ActualOptionFlags and 1=0) and (OptionFlags and 1=1) then
      //We have to move result to widedata
      for i:=0 to l div CharSize -1 do WideData[DestPos+1+i]:=UTF16Char(aRecord.Data^[aPos+i])
      //We are either reading widedata or shortdata
      else  Move(aRecord.Data^[aPos], pResult^, l);
    inc(aPos, l);
    inc(DestPos, l div CharSize);
    ReadStr(aRecord, aPos, ShortData, WideData, OptionFlags, ActualOptionFlags, DestPos ,StrLen);
  end
end;


procedure LoadContinues(const DataStream: TOle2File; const Master: TBaseRecord; var RecordHeader: TRecordHeader);
var
  LastRecord: TBaseRecord;
  Id: Int32;
  Data: PArrayOfByte;
  R: TContinueRecord;
begin
  LastRecord := Master;
  repeat
    Id := RecordHeader.Id;
    Assert(Id = Int32(xlr_CONTINUE));

    GetMem (Data, RecordHeader.Size);
    try
      DataStream.ReadMem(Data[0], RecordHeader.Size);

      R := TContinueRecord.Create(Id, Data, RecordHeader.Size);
    except
      FreeMem(Data);
      raise;
    end;
    LastRecord.AddContinue(R);
    LastRecord := R;
    if not DataStream.NextEof(3) then
    begin
      DataStream.ReadMem(RecordHeader, SizeOf(RecordHeader));
    end
    else
    begin
       //Array.Clear(RecordHeader.Data,0,RecordHeader.Length);
      RecordHeader.Id := Int32(xlr_EOF);  //Return EOFs, so in case of bad formed files we don't get on an infinite loop.
      RecordHeader.Size := 0;
    end;

  until RecordHeader.Id <> Int32(xlr_CONTINUE);
end;


function LoadRecords(const DataStream: TOle2File; var RecordHeader: TRecordHeader): TBaseRecord;
var
  Data: PArrayOfByte;
  R: TBaseRecord;
begin
  GetMem(Data, RecordHeader.Size);
  try
    DataStream.ReadMem(Data^, RecordHeader.Size);
  except
    FreeMem(Data);
    raise;
  end; //except

  //From here, if there is an exception, the mem will be freed by the object
  case RecordHeader.Id of
    xlr_BOF         : R:= TBOFRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_EOF         : R:= TEOFRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_FORMULA     : R:= TFormulaRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_SHRFMLA     : R:= TShrFmlaRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_OBJ         : R:= TObjRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_MSODRAWING  : R:= TDrawingRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_MSODRAWINGGROUP
                    : R:= TDrawingGroupRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_TEMPLATE    : R:= TTemplateRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_TXO         : R:= TTXORecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_NOTE        : R:= TNoteRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_RECALCID,   //So the workbook gets recalculated
    xlr_EXTSST,     // We will have to generate this again
    xlr_DBCELL,     //To find rows in blocks... we need to calculate it again
    xlr_INDEX,      //Same as DBCELL
    xlr_MSODRAWINGSELECTION   // Object selection. We do not need to select any drawing
//    ,xlr_OBPROJ  If we want to disable macros.
                    : R:= TIgnoreRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_DIMENSIONS  //Used range of a sheet
                    : R:= TDimensionsRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_SST         : R:= TSSTRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_BoundSheet  : R:= TBoundSheetRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_CODENAME    : R:= TCodeNameRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_OBPROJ      : R:= TObProjRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_Array       : R:= TArrayRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_Blank       : R:= TBlankRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_BoolErr     : R:= TBoolErrRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_Number      : R:= TNumberRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_MulBlank    : R:= TMulBlankRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_MulRK       : R:= TMulRKRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_RK          : R:= TRKRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_STRING      : R:= TStringRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);//String record saves the result of a formula

    xlr_XF          : R:= TXFRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_FONT        : R:= TFontRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_FORMAT      : R:= TFormatRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_Palette     : R:= TPaletteRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_Style       : R:= TStyleRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_LabelSST    : R:= TLabelSSTRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_Label       : R:= TLabelRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_RSTRING     : R:= TRStringRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_Row         : R:= TRowRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_NAME        : R:= TNameRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_TABLE       : R:= TTableRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_CELLMERGING : R:= TCellMergingRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_CONDFMT     : R:= TCondFmtRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_CF          : R:= TCFRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_DVAL        : R:= TDValRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_HLINK       : R:= THLinkRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_SCREENTIP   : R:= TScreenTipRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_Continue    : R:= TContinueRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_FOOTER      : R:= TPageFooterRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_HEADER      : R:= TPageHeaderRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_PRINTGRIDLINES : R:= TPrintGridLinesRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_LEFTMARGIN,
    xlr_RIGHTMARGIN,
    xlr_TOPMARGIN,
    xlr_BOTTOMMARGIN: R:= TMarginRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_SETUP       : R:= TSetupRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_PLS         : R:= TPlsRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_WSBOOL      : R:= TWsBoolRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_HCENTER,
    xlr_VCENTER     : R:= TPrintCenteredRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_XCT,        // Cached values of a external workbook... not supported yet
    xlr_CRN         // Cached values also
                    : R:=TIgnoreRecord.Create(RecordHeader.Id, Data, RecordHeader.Size); //raise Exception.Create (ErrExtRefsNotSupported);
    xlr_SUPBOOK     : R:= TSupBookRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_EXTERNSHEET : R:= TExternSheetRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_EXTERNNAME,
    xlr_EXTERNNAME2
                    : R:= TExternNameRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_ChartAI     : R:= TChartAIRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_Window1     : R:= TWindow1Record.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_Window2     : R:= TWindow2Record.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_1904        : R:= T1904Record.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_REFMODE     : R:= TRefModeRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_PRECISION   : R:= TPrecisionRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_BOOKBOOL    : R:= TBookBoolRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_PANE        : R:= TPaneRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_AUTOFILTERINFO : R:= TAutoFilterInfoRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_SCL         : R:= TSCLRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_GUTS        : R:= TGutsRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_HORIZONTALPAGEBREAKS: R:= THPageBreakRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_VERTICALPAGEBREAKS  : R:= TVPageBreakRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_COLINFO     : R:= TColInfoRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_DEFCOLWIDTH : R:= TDefColWidthRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_STANDARDWIDTH:R:= TStandardWidthRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_DEFAULTROWHEIGHT: R:= TDefRowHeightRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_FILEPASS: raise Exception.Create(ErrFileIsPasswordProtected);

    xlr_BEGIN: R:= TBeginRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
    xlr_END: R:= TEndRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);

    xlr_ChartFbi: R:=TIgnoreRecord.Create(RecordHeader.Id, Data, RecordHeader.Size); //charfbi might be dangerous if copied.

    else              R:= TBaseRecord.Create(RecordHeader.Id, Data, RecordHeader.Size);
  end; //case

  //Peek at the next record...
  if not DataStream.NextEof(3) then
  begin
    DataStream.ReadMem(RecordHeader, SizeOf(RecordHeader));
    if RecordHeader.Id = xlr_Continue then LoadContinues(DataStream, R, RecordHeader)
    else if RecordHeader.Id=xlr_Table then
      if (R is TFormulaRecord) then
      begin
        (R as TFormulaRecord).TableRecord:=LoadRecords(DataStream, RecordHeader) as TTableRecord;
      end
      else Exception.Create(ErrExcelInvalid)
    else if RecordHeader.Id=xlr_Array then
      if (R is TFormulaRecord) then
      begin
        (R as TFormulaRecord).ArrayRecord:=LoadRecords(DataStream, RecordHeader) as TArrayRecord;
      end
      else Exception.Create(ErrExcelInvalid)

    else if RecordHeader.Id=xlr_ScreenTip then
      if (R is THLinkRecord) then
      begin
        (R as THLinkRecord).AddHint(LoadRecords(DataStream, RecordHeader) as TScreenTipRecord);
      end
      else Exception.Create(ErrExcelInvalid)
    else
    begin
      if RecordHeader.Id = xlr_String then
      begin
        if not (R is TFormulaRecord) and not (R is TShrFmlaRecord) and not (R is TArrayRecord) and not (R is TTableRecord) then raise Exception.Create(ErrExcelInvalid);
      end;
    end;
  end else
  begin
    RecordHeader.Id := xlr_EOF;
    RecordHeader.Size := 0;
  end;

  Result:=R;
end;

{ TBaseRecord }

procedure TBaseRecord.AddContinue(const aContinue: TContinueRecord);
begin
  if Continue<>nil then raise Exception.Create(ErrInvalidContinue);
  Continue:=aContinue;
end;

function TBaseRecord.CopyTo: TBaseRecord;
begin
  if Self=nil then Result:= nil   //for this to work, this cant be a virtual method
  else Result:=DoCopyTo;
end;

constructor TBaseRecord.Create(const aId: word; const aData: PArrayOfByte; const aDataSize: integer);
begin
  inherited Create;
  Id := aId;
  Data := aData;
  DataSize := aDataSize;
end;

destructor TBaseRecord.Destroy;
begin
  if Data<>nil then FreeMem(Data);
  FreeAndNil(Continue);
  inherited;
end;

function TBaseRecord.DoCopyTo: TBaseRecord;
var
  NewData: PArrayOfByte;
begin
  GetMem(NewData, DataSize);
  try
    Move(Data^, NewData^, DataSize);
    Result:= ClassOfTBaseRecord(ClassType).Create(Id, NewData, DataSize);
  except
    FreeMem(NewData);
    raise;
  end;
  if Continue<>nil then Result.Continue:= Continue.CopyTo as TContinueRecord;
end;

procedure TBaseRecord.SaveDataToStream(const Workbook: TOle2File;
  const aData: PArrayOfByte);
begin
  Workbook.WriteMem(Id, Sizeof(Id));
  Workbook.WriteMem(DataSize, Sizeof(DataSize));
  if DataSize > 0 then
    Workbook.WriteMem(aData^, DataSize);
end;

procedure TBaseRecord.SaveToStream(const Workbook: TOle2File);
begin
  SaveDataToStream(Workbook, Data);
  if Continue<>nil then Continue.SaveToStream(Workbook);
end;

function TBaseRecord.TotalSize: integer;
begin
  Result:=SizeOf(TRecordHeader)+ DataSize;
  if Continue<>nil then Result:=Result+Continue.TotalSize;
end;

function TBaseRecord.TotalSizeNoHeaders: integer;
begin
  Result:=DataSize;
  if Continue<>nil then Result:=Result+Continue.TotalSizeNoHeaders;
end;

{ TBaseRowColRecord }

procedure TBaseRowColRecord.ArrangeInsertRowsAndCols(const aRowPos, aRowCount, aColPos, aColCount:integer; const SheetInfo: TSheetInfo);
begin
  if DataSize<4 then raise Exception.CreateFmt(ErrWrongExcelRecord,[Id]);
  if (SheetInfo.InsSheet<0) or (SheetInfo.FormulaSheet<> SheetInfo.InsSheet) then exit;
  if aRowPos<= Row then IncWord(Data, 0, aRowCount, Max_Rows);  //row;
  //Issues if we have 256 columns.
  if aColPos<= Column then IncWord(Data, 2, aColCount, Max_Columns);  //col;
end;

constructor TBaseRowColRecord.Create(const aId: word; const aData: PArrayOfByte; const aDataSize: integer);
begin
  inherited;
  if DataSize<4 then raise Exception.CreateFmt(ErrWrongExcelRecord,[Id]);
end;

function TBaseRowColRecord.FixTotalSize(const NeedsRecalc: boolean): int64;
begin
  Result := TotalSize;
end;

procedure TBaseRowColRecord.ArrangeCopyRowsAndCols(const RowOffset, ColOffset: integer);
begin
  if DataSize<4 then raise Exception.CreateFmt(ErrWrongExcelRecord,[Id]);
  SetWord(Data, 0, Row+RowOffset);  //row;
  SetWord(Data, 2, Column+ColOffset);  //col;
end;

function TBaseRowColRecord.GetColumn: word;
begin
  GetColumn:=GetWord(Data,2);