tmsuole2impl.pas

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

  begin  //return BitConverter.ToUInt32(Data, 0x0074+StartPos);
    begin Result := UInt32(((Data[116 + StartPos] + (Data[117 + StartPos] shl 8)) + (Data[118 + StartPos] shl 16)) + (Data[119 + StartPos] shl 24)); exit; end;
  end;
  {$INCLUDE FLXCOMPILER.INC}
end;

class procedure TOle2Directory.SetSectStart(const Data: ByteArray; const StartPos: Int32; const value: Int64);
var
  tPos: Int32;
begin
  {$R-}
  begin  //BitConverter.GetBytes((UInt32)value).CopyTo(Data,0x0074+StartPos);
    tPos := 116 + StartPos;
    Data[tPos] := Byte(value);
    Data[tPos + 1] := Byte(value shr 8);
    Data[tPos + 2] := Byte(value shr 16);
    Data[tPos + 3] := Byte(value shr 24);
  end;
  {$INCLUDE FLXCOMPILER.INC}
end;

class function TOle2Directory.GetSize(const Data: ByteArray; const StartPos: Int32): Int64;
begin
  {$R-}
  begin  // return BitConverter.ToUInt32(Data, 0x0078+StartPos);
    begin Result := UInt32(((Data[120 + StartPos] + (Data[121 + StartPos] shl 8)) + (Data[122 + StartPos] shl 16)) + (Data[123 + StartPos] shl 24)); exit; end;
  end;
  {$INCLUDE FLXCOMPILER.INC}
end;

class procedure TOle2Directory.SetSize(const Data: ByteArray; const StartPos: Int32; const value: Int64);
var
  tPos: Int32;
begin
  {$R-}
  begin  //BitConverter.GetBytes((UInt32)value).CopyTo(Data,0x0078+StartPos);
    tPos := 120 + StartPos;
    Data[tPos] := Byte(value);
    Data[tPos + 1] := Byte(value shr 8);
    Data[tPos + 2] := Byte(value shr 16);
    Data[tPos + 3] := Byte(value shr 24);
  end;
  {$INCLUDE FLXCOMPILER.INC}
end;

class procedure TOle2Directory.Clear(const Data: ByteArray; const StartPos: Int32);
begin
  FillChar(Data[StartPos], ((64 + 2) //Clear name and name length.
                            + 1) //StgType invalid
                            + 1, 0);//DeColor

   //Data[StartPos+64+2]=0;
  FillChar(Data[StartPos + 68], 4, 1);  //Left Sibling
  FillChar(Data[StartPos + 72], 4, 1);  //Right Sibling
  FillChar(Data[StartPos + 76], 4, 1);  //Child Sibling
  FillChar(Data[StartPos + 80], TOle2Directory_DirectorySize - 80, 0);  //All else
end;

class function TOle2Directory.GetLeftSid(const Data: ByteArray; const StartPos: Int32): Int32;
begin
  Result := Int32((@Data[68 + StartPos])^);
end;

class procedure TOle2Directory.SetLeftSid(const Data: ByteArray; const StartPos: Int32; const value: Int32);
begin
  System.Move(value, Data[68 + StartPos], SizeOf(value));
end;

class function TOle2Directory.GetRightSid(const Data: ByteArray; const StartPos: Int32): Int32;
begin
  Result := Int32((@Data[72 + StartPos])^);
end;

class procedure TOle2Directory.SetRightSid(const Data: ByteArray; const StartPos: Int32; const value: Int32);
begin
  System.Move(value, Data[72 + StartPos], SizeOf(value));
end;

class function TOle2Directory.GetChildSid(const Data: ByteArray; const StartPos: Int32): Int32;
begin
  Result := Int32((@Data[76 + StartPos])^);
end;

class procedure TOle2Directory.SetChildSid(const Data: ByteArray; const StartPos: Int32; const value: Int32);
begin
  System.Move(value, Data[76 + StartPos], SizeOf(value));
end;

class function TOle2Directory.GetColor(const Data: ByteArray; const StartPos: Int32): DECOLOR;
begin
  Result := DECOLOR(Data[67 + StartPos]);
end;

class procedure TOle2Directory.SetColor(const Data: ByteArray; const StartPos: Int32; const value: DECOLOR);
begin
  Data[67 + StartPos] := Byte(value);
end;

function TOle2Directory.Get_NameSize(): Int32;
begin
  Result := GetNameSize(Data, 0);
end;

procedure TOle2Directory.Set_NameSize(const value: Int32);
begin
  if (value < 0) or (value > 62) then
    raise Exception.CreateFmt(ErrTooManyEntries, [value, 62]);

  Data[64] := Byte(value + 2);
end;

function TOle2Directory.Get_Name(): UTF16String;
begin
  Result := GetName(Data, 0);
end;

procedure TOle2Directory.Set_Name(const value: UTF16String);
var
  aValue: UTF16String;
  i: integer;
  len: Integer;
begin
  SetLength(aValue, 32);
  len := 32;
  if Length(Value) < len then len := Length(Value);
  if len > 0 then System.Move(value[1], aValue[1], len * 2);
  for i  := len + 1 to 32 do aValue[i] := #0;

  NameSize := len * 2;
{$IFDEF DELPHI2008UP}
  TEncoding.Unicode.GetBytes(aValue, 1, len, TBytes(Data), 0);
{$ELSE}
  System.Move(aValue[1], Data[0], len);
{$ENDIF}
end;

function TOle2Directory.Get_ObjType(): STGTY;
begin
  Result := GetType(Data, 0);
end;

procedure TOle2Directory.Set_ObjType(const value: STGTY);
begin
  Data[66] := Byte(value);
end;

function TOle2Directory.Get_SectStart(): Int64;
begin
  Result := GetSectStart(Data, 0);
end;

procedure TOle2Directory.Set_SectStart(const value: Int64);
begin
  SetSectStart(Data, 0, value);
end;

function TOle2Directory.Get_xulSize(): Int64;
begin
  Result := GetSize(Data, 0);
end;

procedure TOle2Directory.Set_xulSize(const value: Int64);
begin
  SetSize(Data, 0, value);
end;

{.$endregion}
{.$region 'TSectorBuffer'}
{ TSectorBuffer }
constructor TSectorBuffer.Create(const aHeader: TOle2Header; const aStream: TStream);
begin
  inherited Create;
  //Initializations
  Changed := false;
  FSectorId := -1;
  
  Header := aHeader;
  DataStream := aStream;
  SetLength (Data, Header.SectorSize);
  FillChar(Data[0], Length(Data), 0);
  Changed := false;
  FSectorId := -1;
end;

procedure TSectorBuffer.Load(const SectNo: Int64);
begin
  if Changed then
    Save;
  
  if SectNo = FSectorId then
    exit;
  
  DataStream.Seek(Header.SectToStPos(SectNo), soFromBeginning);
  FSectorId := -1;  //It is invalid until we read the data.
  StreamRead(DataStream, Data, 0, Length(Data), false);
  FSectorId := SectNo;
end;

procedure TSectorBuffer.Save();
begin
  if Changed then
  begin
    DataStream.Seek(Header.SectToStPos(FSectorId), soFromBeginning);
    DataStream.WriteBuffer(Data[0], Length(Data));
    Changed := false;
  end;

end;

procedure TSectorBuffer.Read(const aBuffer: ByteArray; const BufferPos: Int64; out nRead: Int64; const StartPos: Int64; const Count: Int64; const SectorSize: Int64);
begin
  if Count > (SectorSize - StartPos) then
    nRead := SectorSize - StartPos else
    nRead := Count;

  System.Move(Data[Int32(StartPos)], aBuffer[Int32(BufferPos)], Int32(nRead));  //The (int) are to be compatible with CF
end;

procedure TSectorBuffer.ReadMem(var aBuffer; const BufferPos: Int64; out nRead: Int64; const StartPos: Int64; const Count: Int64; const SectorSize: Int64);
var
  MemBuffer: PArrayOfByte;
begin
  if Count > (SectorSize - StartPos) then
  nRead := SectorSize - StartPos else
  nRead := Count;

  MemBuffer := PArrayOfByte(@aBuffer);
  System.Move(Data[Int32(StartPos)], Membuffer[Int32(BufferPos)], Int32(nRead));  //The (int) are to be compatible with CF
end;

//--------------------------------------------------------------------------------------------------------------------------//{.$endregion}

{.$region 'TOle2File'}
{ TOle2File }
constructor TOle2File.Create(const aStream: TStream);
begin
  //private TOle2DirList DirList;
  Create(aStream, false);
end;

constructor TOle2File.Create(const aStream: TStream; const AvoidExceptions: Boolean);
var
  StreamPosition: Int64;
begin
  inherited Create;
  //Initializations
  TOle2FileStr := 'TOle2File';
  disposed := false;
  PreparedForWrite := false;
  DIRStartPos := -1;
  
  FStream := aStream;
  StreamPosition := aStream.Position;
  Header := TOle2Header.Create(FStream, AvoidExceptions);
  if Header.NotXls97 then
  begin
    NotXls97 := true;
    FStream.Position := StreamPosition;
    exit;
  end;
  
  FAT := TOle2FAT.Create(Header, FStream);
  MiniFAT := TOle2MiniFAT.Create(Header, FStream, FAT);
  ROOT := FindRoot;
  SectorBuffer := TSectorBuffer.Create(Header, FStream);
  FEncryption := TEncryptionData.Create('', nil, nil);
end;

procedure TOle2File.Close();
begin
  Destroy;
end;

destructor TOle2File.Destroy;
begin
  try try try try try try try
  FinishStream;
  finally
    FreeAndNil(Header);
  end;
  finally
    FreeAndNil(MiniFat);
  end;
  finally
    FreeAndNil(FAT);
  end;
  finally
    FreeAndNil(SectorBuffer);
  end;
  finally
    FreeAndNil(FEncryption);
  end;
  finally
    FreeAndNil(DIR);
  end;
  finally
    FreeAndNil(ROOT);
  end;
  inherited;
end;

function TOle2File.FindDir(const DirName: UTF16String): TOle2Directory;
var
  Data: ByteArray;
  DirSect: Int64;
  k: UInt32;
  nd: ByteArray;
begin
  Result := nil;
  SetLength (Data, Header.SectorSize);
  FillChar(Data[0], System.Length(Data), 0);
  DirSect := Header.sectDirStart;
  while DirSect <> TOle2Header_ENDOFCHAIN do
  begin
    begin
      FStream.Seek(Header.SectToStPos(DirSect), soFromBeginning);
      StreamRead(FStream, Data, 0, System.Length(Data), false);
      k := 0;
      while k < Header.SectorSize do
      try
        if TOle2Directory.GetName(Data, k) = DirName then
        begin
          SetLength (nd, TOle2Directory_DirectorySize);
          FillChar(nd[0], System.Length(nd), 0);
          System.Move(Data[k], nd[0], System.Length(nd));
          begin Result := TOle2Directory.Create(nd); exit; end;
        end;

      finally
        k:= k + TOle2Directory_DirectorySize;
      end;

      DirSect := FAT.GetNextSector(DirSect);
    end;
  end;
end;

function TOle2File.FindRoot(): TOle2Directory;
var
  Data: ByteArray;
  DirSect: Int64;
begin
  SetLength (Data, TOle2Directory_DirectorySize);
  FillChar(Data[0], System.Length(Data), 0);
  DirSect := Header.sectDirStart;
  FStream.Seek(Header.SectToStPos(DirSect), soFromBeginning);
  StreamRead(FStream, Data, 0, System.Length(Data), false);
  Result := TOle2Directory.Create(Data);
end;

procedure TOle2File.SelectStream(const StreamName: UTF16String);
begin
  if PreparedForWrite then
    raise Exception.CreateFmt(ErrInvalidStream, [StreamName]);

  FreeAndNil(DIR);  
  DIR := FindDir(StreamName);
  if DIR = nil then
    raise Exception.CreateFmt(ErrFileIsNotXLS,[FileName]);

   //XlsMessages.ThrowException(XlsErr.ErrInvalidStream, StreamName);
  StreamPos := 0;
end;

function TOle2File.NextEof(const Count: Int32): Boolean;
begin
  if PreparedForWrite then
    raise Exception.CreateFmt(ErrInvalidStream, ['']);

  Result := (StreamPos + Count) >= Length;
end;

procedure TOle2File.ReadMem(var aBuffer; const Count: Int32);
var
  DIRulSize: Int64;
  MiniSectsOn1Sect: Int64;
  MiniFatSectorOfs: Int64;
  ActualMiniFatSector: Int64;
  SectorOfs: Int64;
  MiniStreamSector: Int64;
  nRead: Int64;
  TotalRead: Int64;
  MiniOffset: Int64;
  MiniStart: Int64;
  ActualSector: Int64;
begin
  //if System.Length(aBuffer) = 0 then  // this is needed to avoid reading into a free record.
  //  exit;

  if DIR = nil then  //No stream selected
    exit;

  if PreparedForWrite then
    raise Exception.CreateFmt(ErrInvalidStream, ['']);

  DIRulSize := DIR.ulSize;
  if (StreamPos + Count) > DIRulSize then  //Reading past the end of the stream.
    raise Exception.CreateFmt(ErrEofReached, [(StreamPos + Count) - DIRulSize]);

  if DIRulSize < Header.ulMiniSectorCutoff then
  begin
    MiniSectsOn1Sect := 1 shl (Header.uSectorShift - Header.uMiniSectorShift);  //Read from the MiniFat.
    MiniFatSectorOfs := StreamPos shr Header.uMiniSectorShift;  //Find the minifat Sector number we have to read
    ActualMiniFatSector := MiniFAT.FindSector(DIR.SectStart, MiniFatSectorOfs);
    SectorOfs := ActualMiniFatSector shr (Header.uSectorShift - Header.uMiniSectorShift);  //Now, find this minifat sector into the MiniStream
  // MiniFAT/8
    MiniStreamSector := FAT.FindSector(ROOT.SectStart, SectorOfs);
    nRead := 0;
    TotalRead := 0;