tmsuole2impl.pas

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

  FileSignature[2] := 17;
  FileSignature[3] := 224;
  FileSignature[4] := 161;
  FileSignature[5] := 177;
  FileSignature[6] := 26;
  FileSignature[7] := 225;

  StartOfs := aStream.Position;
  SetLength (Data, TOle2Header_HeaderSize - TOle2Header_DifEntries);
  FillChar(Data[0], Length(Data), 0);
  if (aStream.Size - StartOfs) < Length(Data) then
  begin
    if AvoidExceptions then
    begin
      NotXls97 := true;
      exit;
    end;

    raise Exception.CreateFmt(ErrFileIsNotXLS,['']);
  end;

  StreamRead(aStream, Data, 0, Length(Data), false);
  if not CompareArray(Data, FileSignature, Length(FileSignature)) then
  begin
    if AvoidExceptions then
    begin
      NotXls97 := true;
      exit;
    end;

    raise Exception.CreateFmt(ErrFileIsNotXLS,['']);
  end;

  uSectorShift := FuSectorShift;
  SectorSize := FSectorSize;
  ulMiniSectorCutoff := FulMiniSectorCutoff;
end;

procedure TOle2Header.Save(const aStream: TStream);
begin
  aStream.WriteBuffer(Data[0], Length(Data));
end;

class function TOle2Header.CompareArray(const a1: ByteArray; const a2: ByteArray; const length: Int32): Boolean;
begin
  Result := CompareMem(@a1[0], @a2[0], length)
end;

function TOle2Header.uDIFEntryShift(): Int32;
begin
  Result := uSectorShift - 2;
end;

function TOle2Header.SectToStPos(const Sect: Int64): Int64;
begin
  Result := ((Sect shl uSectorShift) + TOle2Header_HeaderSize) + StartOfs;
end;

function TOle2Header.SectToStPos(const Sect: Int64; const Ofs: Int64): Int64;
begin
  Result := ((Sect shl uSectorShift) + TOle2Header_HeaderSize) + Ofs;
end;

function TOle2Header.Get_FuSectorShift(): Int32;
begin  //UInt16 has a bug with mono
  Result := UInt16((@Data[30])^);
end;

function TOle2Header.Get_FSectorSize(): UInt32;
begin
  Result := UInt32(1) shl FuSectorShift;
end;

function TOle2Header.Get_uMiniSectorShift(): Int32;
begin
  Result := UInt16((@Data[32])^);
end;

function TOle2Header.Get_MiniSectorSize(): UInt32;
begin
  Result := UInt32(1) shl uMiniSectorShift;
end;

function TOle2Header.Get_csectFat(): UInt32;
begin
  Result := UInt32((@Data[44])^);
end;

procedure TOle2Header.Set_csectFat(const value: UInt32);
begin
  System.Move(value, Data[44], SizeOf(value));
end;

function TOle2Header.Get_sectDirStart(): UInt32;
begin
  Result := UInt32((@Data[48])^);
end;

procedure TOle2Header.Set_sectDirStart(const value: UInt32);
begin
  System.Move(value, Data[48], SizeOf(value));
end;

function TOle2Header.Get_FulMiniSectorCutoff(): UInt32;
begin
  Result := UInt32((@Data[56])^);
end;

function TOle2Header.Get_sectMiniFatStart(): UInt32;
begin
  Result := UInt32((@Data[60])^);
end;

procedure TOle2Header.Set_sectMiniFatStart(const value: UInt32);
begin
  System.Move(value, Data[60], SizeOf(value));
end;

function TOle2Header.Get_csectMiniFat(): UInt32;
begin
  Result := UInt32((@Data[64])^);
end;

procedure TOle2Header.Set_csectMiniFat(const value: UInt32);
begin
  System.Move(value, Data[64], SizeOf(value));
end;

function TOle2Header.Get_sectDifStart(): UInt32;
begin
  Result := UInt32((@Data[68])^);
end;

procedure TOle2Header.Set_sectDifStart(const value: UInt32);
begin
  System.Move(value, Data[68], SizeOf(value));
end;

function TOle2Header.Get_csectDif(): UInt32;
begin
  Result := UInt32((@Data[72])^);
end;

procedure TOle2Header.Set_csectDif(const value: UInt32);
begin
  System.Move(value, Data[72], SizeOf(value));
end;

{.$endregion}
{.$region 'TOle2FAT'}
{ TOle2FAT }
constructor TOle2FAT.Create();
begin
  inherited Create;
  //Initializations
  LastFindSectorOfs := -1;
  LastFindSectorStart := -1;
  LastFindSectorRes := 0;

end;

constructor TOle2FAT.Create(const aHeader: TOle2Header; const aStream: TStream);
var
  DifSect0: ByteArray;
  DifPos: UInt32;
  DifSect: ByteArray;
  i: UInt32;
begin
  Create;
  Header := aHeader;
  if aStream <> nil then
  begin
    Capacity := (Int32(aHeader.csectFat shl (uFATEntryShift and 31)) + TOle2Header_DifsInHeader) + 16;  //This is, number of fat sectors*(SectorSize/4)+109+ extra_just_in_case
    SetLength (DifSect0, TOle2Header_DifEntries);
    FillChar(DifSect0[0], Length(DifSect0), 0);
    aStream.Seek((Header.StartOfs + TOle2Header_HeaderSize) - TOle2Header_DifEntries, soFromBeginning);
    StreamRead(aStream, DifSect0, 0, Length(DifSect0), false);
    LoadDifSector(DifSect0, 0, TOle2Header_DifEntries, aStream);  //First 109 DIF records are on the header.

     //if there are Dif sectors, load them.
    DifPos := Header.sectDifStart;
    SetLength (DifSect, Header.SectorSize);
    FillChar(DifSect[0], Length(DifSect), 0);
    for i := 1 to Header.csectDif do
    begin
      if DifPos = TOle2Header_ENDOFCHAIN then
        raise Exception.Create(ErrExcelInvalid);

      aStream.Seek(Header.SectToStPos(DifPos), soFromBeginning);
      StreamRead(aStream, DifSect, 0, Length(DifSect), false);
      LoadDifSector(DifSect, 0, Header.SectorSize - 4, aStream);
      DifPos := UInt32((@DifSect[Int32(Header.SectorSize) - 4])^);
    end;

  end;

 //Some sanity checks
 //not really... sometimes it is not. if (DifPos!=TOle2Header.ENDOFCHAIN) throw new IOException(XlsMessages.GetString(XlsErr.ErrExcelInvalid));
end;

destructor TOle2FAT.Destroy;
begin
  inherited;
end;

function TOle2FAT.uFATEntryShift(): Int32;
begin
  Result := Header.uSectorShift - 2;
end;

function TOle2FAT.GetNextSector(const Sect: Int64): Int64;
begin
  Result := UInt32(Self[Int32(Sect)]);
end;

function TOle2FAT.FindSector(const StartSect: Int64; const SectOfs: Int64): Int64;
var
  NewSect: Int64;
  RealSectOfs: Int64;
  i: Int32;
begin
  NewSect := StartSect;
  RealSectOfs := SectOfs;
  if (LastFindSectorStart = StartSect) and (SectOfs >= LastFindSectorOfs) then  //Optimization for sequential read.
  begin
    NewSect := LastFindSectorRes;
    RealSectOfs:= RealSectOfs - LastFindSectorOfs;
  end;

  for i := 0 to RealSectOfs - 1 do
  begin
    NewSect := UInt32(Self[Int32(NewSect)]);
  end;

  LastFindSectorStart := StartSect;
  LastFindSectorOfs := SectOfs;
  LastFindSectorRes := NewSect;
  Result := NewSect;
end;

procedure TOle2FAT.LoadDifSector(const data: ByteArray; const inipos: UInt32; const endpos: UInt32; const aStream: TStream);
var
  FatSect: ByteArray;
  FatEntries: Int32;
  i: UInt32;
  FatId: UInt32;
  k: Int32;
begin
  SetLength (FatSect, Header.SectorSize);
  FillChar(FatSect[0], Length(FatSect), 0);
  FatEntries := 1 shl uFATEntryShift;
  i := inipos;
  while i < endpos do
  try
    FatId := UInt32((@data[i])^);
    if FatId = TOle2Header_ENDOFCHAIN then
      exit;

    if FatId = TOle2Header_FREESECT then
    begin
       //We have to keep track of the FAT position.
      for k := 0 to FatEntries - 1 do
        Add(TOle2Header_FREESECT);

      continue;
    end;

    aStream.Seek(Header.SectToStPos(FatId), soFromBeginning);
    StreamRead(aStream, FatSect, 0, Length(FatSect), false);
    LoadFatSector(FatSect);
  finally
    i:= i + 4;
  end;

end;

procedure TOle2FAT.LoadFatSector(const data: ByteArray);
var
  HeaderSectorSize: UInt32;
  i: Int64;
  Sect: UInt32;
begin
  HeaderSectorSize := Header.SectorSize;
  i := 0;
  while i < HeaderSectorSize do
  try
    Sect := UInt32((@data[i])^);
     //No, we have to load it the same. if (Sect== TOle2Header.FREESECT) continue;
    Add(Sect);
  finally
    i:= i + 4;
  end;

end;

{.$endregion}
{.$region 'TOle2MiniFAT'}
{ TOle2MiniFAT }
constructor TOle2MiniFAT.Create();
begin
  inherited Create;
end;

constructor TOle2MiniFAT.Create(const aHeader: TOle2Header; const aStream: TStream; const aFAT: TOle2FAT);
var
  MiniFatSect: ByteArray;
  MiniFatPos: Int64;
  i: UInt32;
begin
  Create;
  Header := aHeader;
  Capacity := Int32(aHeader.csectMiniFat shl ((aHeader.uSectorShift - 2) and 31)) + 16;  //This is, number of minifat sectors*(SectorSize/4)+ extra_just_in_case
  SetLength (MiniFatSect, aHeader.SectorSize);
  FillChar(MiniFatSect[0], Length(MiniFatSect), 0);
  MiniFatPos := aHeader.sectMiniFatStart;
  for i := 1 to aHeader.csectMiniFat do
  begin
    if MiniFatPos = TOle2Header_ENDOFCHAIN then
      raise Exception.Create(ErrExcelInvalid);

    aStream.Seek(aHeader.SectToStPos(MiniFatPos), soFromBeginning);
    StreamRead(aStream, MiniFatSect, 0, Length(MiniFatSect), false);
    LoadMiniFatSector(MiniFatSect);
    MiniFatPos := aFAT.GetNextSector(MiniFatPos);
  end;

end;

function TOle2MiniFAT.GetNextSector(const Sect: Int64): Int64;
begin
  Result := Self[Int32(Sect)];
end;

function TOle2MiniFAT.FindSector(const StartSect: Int64; const SectOfs: Int64): Int64;
var
  NewSect: Int64;
  i: Int32;
begin
  NewSect := StartSect;
  for i := 0 to SectOfs - 1 do
  begin
    NewSect := Self[Int32(NewSect)];
  end;

  Result := NewSect;
end;

procedure TOle2MiniFAT.LoadMiniFatSector(const data: ByteArray);
var
  i: UInt32;
  Sect: UInt32;
begin
  i := 0;
  while i < Header.SectorSize do
  begin
    Sect := UInt32((@data[i])^);
     //NO!  Has to be loaded anyway. if (Sect== TOle2Header.FREESECT)continue;
    Add(Sect);

    i:= i + 4;
  end;

end;

{.$endregion}
{.$region 'TOle2Directory'}
{ TOle2Directory }
constructor TOle2Directory.Create(const aData: ByteArray);
begin
  inherited Create;
  Data := aData;
  ulSize := xulSize;
end;

procedure TOle2Directory.Save(const aStream: TStream);
begin
  xulSize := ulSize;
  aStream.WriteBuffer(Data[0], Length(Data));
end;

class function TOle2Directory.GetNameSize(const Data: ByteArray; const StartPos: Int32): Int32;
var
  nl: Int32;
begin
  nl := Data[64 + StartPos];
  if (nl < 2) or (nl > 64) then
    Result := 0 else
    Result := nl - 2;

end;

class function TOle2Directory.GetName(const Data: ByteArray; const StartPos: Int32): UTF16String;
begin
{$IFDEF DELPHI2008UP}
  Result := TEncoding.Unicode.GetString(TBytes(Data), StartPos, GetNameSize(Data, StartPos));
{$ELSE}
  SetLength(Result, GetNameSize(Data, StartPos) div 2);
  System.Move(Data[StartPos], Result[1], Length(Result)*2);
{$ENDIF}
end;

class function TOle2Directory.GetType(const Data: ByteArray; const StartPos: Int32): STGTY;
begin
  Result := STGTY(Data[66 + StartPos]);
end;

class function TOle2Directory.GetSectStart(const Data: ByteArray; const StartPos: Int32): Int64;
begin
  {$R-}