tmsuole2impl.pas

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

    while TotalRead < Count do
    begin
      begin
        SectorBuffer.Load(MiniStreamSector);
        MiniOffset := (ActualMiniFatSector mod MiniSectsOn1Sect) shl Header.uMiniSectorShift;
        MiniStart := (StreamPos mod Header.MiniSectorSize) + MiniOffset;
        SectorBuffer.ReadMem(aBuffer, TotalRead, nRead, MiniStart, Count - TotalRead, Header.MiniSectorSize + MiniOffset);
        StreamPos:= StreamPos + nRead;
        TotalRead:= TotalRead + nRead;
        if TotalRead < Count then
        begin
          ActualMiniFatSector := MiniFAT.GetNextSector(ActualMiniFatSector);
          SectorOfs := ActualMiniFatSector shr (Header.uSectorShift - Header.uMiniSectorShift);  // MiniFAT/8
          MiniStreamSector := FAT.FindSector(ROOT.SectStart, SectorOfs);
        end;

      end;
    end;
  end
  else
  begin
    SectorOfs := StreamPos shr Header.uSectorShift;  //Read from a normal sector
    ActualSector := FAT.FindSector(DIR.SectStart, SectorOfs);
    nRead := 0;
    TotalRead := 0;
    while TotalRead < Count do
    begin
      begin
        SectorBuffer.Load(ActualSector);
        SectorBuffer.ReadMem(aBuffer, TotalRead, nRead, StreamPos mod Header.SectorSize, Count - TotalRead, Header.SectorSize);
        StreamPos:= StreamPos + nRead;
        if TotalRead < Count then
        begin
          TotalRead:= TotalRead + nRead;
          ActualSector := FAT.GetNextSector(ActualSector);
        end;

      end;
    end;
  end;

end;

procedure TOle2File.Read(const aBuffer: ByteArray; const Count: Int32);
begin
  if System.Length(aBuffer) = 0 then  // this is needed to avoid reading into a free record.
    exit;

  ReadMem(aBuffer[0], Count);
end;

procedure TOle2File.WriteRawMem(const Buffer; const Count: Int32);
begin
  if DIR = nil then  //No stream selected
    exit;

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

  FStream.WriteBuffer(Buffer, Count);
  DIR.ulSize:= DIR.ulSize + Count;
end;

procedure TOle2File.WriteRaw(const Buffer: ByteArray; const Count: Int32);
begin
  if DIR = nil then  //No stream selected
    exit;

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

  FStream.WriteBuffer(Buffer[0], Count);
  DIR.ulSize:= DIR.ulSize + Count;
end;

procedure TOle2File.WriteMem(const Buffer; const Count: Int32);
begin
  //Missing Encryption
  WriteRawMem(Buffer, Count);
end;

procedure TOle2File.Write(Buffer: ByteArray; const Count: Int32);
begin
  if (FEncryption <> nil) and (FEncryption.Engine <> nil) then
    Buffer := FEncryption.Engine.Encode(Buffer, Position, 0, System.Length(Buffer), FEncryption.ActualRecordLen);

  WriteRaw(Buffer, Count);
end;

procedure TOle2File.WriteRaw(const Buffer: ByteArray; const StartPos: Int32; const Count: Int32);
begin
  if DIR = nil then  //No stream selected
    exit;

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

  FStream.WriteBuffer(Buffer[StartPos], Count);
  DIR.ulSize:= DIR.ulSize + Count;
end;

procedure TOle2File.WriteHeader(const Id: UInt16; const Len: UInt16);
var
  Header: ByteArray;
begin
  SetLength (Header, 4);
  System.Move(Id, Header[0], 2);
  System.Move(Len, Header[0], 2);

  WriteRaw(Header, 0, System.Length(Header));
  FEncryption.ActualRecordLen := Len;
end;

procedure TOle2File.Write(Buffer: ByteArray; const StartPos: Int32; const Count: Int32);
begin
  if DIR = nil then  //No stream selected
    exit;

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

  if (FEncryption <> nil) and (FEncryption.Engine <> nil) then
    Buffer := FEncryption.Engine.Encode(Buffer, Position, StartPos, Count, FEncryption.ActualRecordLen);

  FStream.WriteBuffer(Buffer[StartPos], Count);
  DIR.ulSize:= DIR.ulSize + Count;
end;

procedure TOle2File.Write16(Buffer: UInt16);
begin
  if DIR = nil then  //No stream selected
    exit;
  
  if not PreparedForWrite then
    raise Exception.CreateFmt(ErrInvalidStream, ['']);
  
  if (FEncryption <> nil) and (FEncryption.Engine <> nil) then
    Buffer := FEncryption.Engine.Encode(Buffer, Position, FEncryption.ActualRecordLen);

  FStream.WriteBuffer(Buffer, 2);
  DIR.ulSize:= DIR.ulSize + 2;
end;

procedure TOle2File.Write32(Buffer: UInt32);
begin
  if (FEncryption <> nil) and (FEncryption.Engine <> nil) then
    Buffer := FEncryption.Engine.Encode(Buffer, Position, FEncryption.ActualRecordLen);

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

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

  FStream.WriteBuffer(Buffer, 4);
  DIR.ulSize:= DIR.ulSize + 4;
end;

class function TOle2File.FindString(const s: UTF16String; const list: StringArray): Boolean;
var
  i: Int32;
begin
  for i := 0 to System.Length(list) - 1 do
    if list[i] = s then
      begin Result := true; exit; end;


  Result := false;
end;

procedure TOle2File.SeekForward(const Offset: Int64);
var
  Tmp: ByteArray;
begin
  if Position > Offset then
    raise Exception.Create(ErrInvalidPropertySector);

  if Offset > Position then
  begin
    SetLength (Tmp, Offset - Position);
    FillChar(Tmp[0], System.Length(Tmp), 0);
    Read(Tmp, System.Length(Tmp));
  end;
  
end;

procedure TOle2File.MarkDeleted(const i: Int32; const Result: TDirEntryList; const Level: Int32);
begin
  if Result[i].Deleted then
    exit;
  
  Result[i].Deleted := true;
  if Result[i].ChildSid >= 0 then
    MarkDeleted(Result[i].ChildSid, Result, Level + 1);
  
  if (Level > 0) and (Result[i].LeftSid >= 0) then
    MarkDeleted(Result[i].LeftSid, Result, Level + 1);
  
  if (Level > 0) and (Result[i].RightSid >= 0) then
    MarkDeleted(Result[i].RightSid, Result, Level + 1);
  
end;

class procedure TOle2File.DeleteNode(const Result: TDirEntryList; var ParentLeaf: Int32);
var
  NextNode: Int32;
  PreviousNode: Int32;
begin
  if (Result[ParentLeaf].LeftSid < 0) and (Result[ParentLeaf].RightSid < 0) then  //It is a final node
  begin
    ParentLeaf := -1;
    exit;
  end;
  
  if Result[ParentLeaf].LeftSid < 0 then  //Only right branch.
  begin
    ParentLeaf := Result[ParentLeaf].RightSid;
    exit;
  end;
  
  if Result[ParentLeaf].RightSid < 0 then  //Only left branch.
  begin
    ParentLeaf := Result[ParentLeaf].LeftSid;
    exit;
  end;
  
  NextNode := Result[ParentLeaf].RightSid;  //Leaf has both branchs.
  //Relabel the node as its successor and delete the successor
  //--------------------------------------------------------------//
  //Example: Delete node 3 here
  //           10
  //        3       
  //     2      6     
  //          4    7
  //            5    
  // We need to relabel 4 as 3, and hang 5 from 6.
  //--------------------------------------------------------------//
  //Find the next node. (once to the right and then always left)
  PreviousNode := -1;
  while Result[NextNode].LeftSid >= 0 do
  begin
    begin
      PreviousNode := NextNode;
      NextNode := Result[NextNode].LeftSid;
    end;
  end;

   //Rename it.
  Result[NextNode].LeftSid := Result[ParentLeaf].LeftSid;  //LeftSid is always-1, we are at the left end.
  if PreviousNode >= 0 then  //If parentNode=-1, we are at the first node (6 on the example) and we don't have to fix the right part.
  begin
    if Result[NextNode].RightSid >= 0 then
      Result[PreviousNode].LeftSid := Result[NextNode].RightSid else
      Result[PreviousNode].LeftSid := -1;
    
    Result[NextNode].RightSid := Result[ParentLeaf].RightSid;
  end;
  
  ParentLeaf := NextNode;
end;

procedure TOle2File.FixNode(const Result: TDirEntryList; var ParentNode: Int32);
begin
  while (ParentNode > 0) and Result[ParentNode].Deleted do
  begin
    DeleteNode(Result, ParentNode)end;
  if ParentNode < 0 then
    exit;
  
  if Result[ParentNode].LeftSid >= 0 then
    FixNode(Result, Result[ParentNode].LeftSid);
  
  if Result[ParentNode].RightSid >= 0 then
    FixNode(Result, Result[ParentNode].RightSid);
  
  if Result[ParentNode].ChildSid >= 0 then
    FixNode(Result, Result[ParentNode].ChildSid);
  
end;

function TOle2File.ReadDirs(const DeletedStorages: StringArray; var PaintItBlack: Boolean): TDirEntryList;
var
  DirSect: Int64;
  DirSector: ByteArray;
  i: Int32;
  FakeParent: Int32;
begin
  Result := TDirEntryList.Create;
  try
    DirSect := Header.sectDirStart;
    SetLength (DirSector, Header.SectorSize);
    FillChar(DirSector[0], System.Length(DirSector), 0);
    while DirSect <> TOle2Header_ENDOFCHAIN do
    begin
      begin
        FStream.Seek(Header.SectToStPos(DirSect), soFromBeginning);
         //Read the whole sector, tipically 4 DIR entries.
        StreamRead(FStream, DirSector, 0, System.Length(DirSector), false);
        i := 0;
        while i < System.Length(DirSector) do
        try
          Result.Add(TOneDirEntry.Create(TOle2Directory.GetName(DirSector, i), TOle2Directory.GetLeftSid(DirSector, i), TOle2Directory.GetRightSid(DirSector, i), TOle2Directory.GetChildSid(DirSector, i), TOle2Directory.GetColor(DirSector, i)));
        finally
          i:= i + TOle2Directory_DirectorySize;
        end;
      
        DirSect := FAT.GetNextSector(DirSect);
      end;
    end;
     // Tag deleted storages and its children.
    for i := 1 to Result.Count - 1 do  //Skip 0, we can't delete root.
    begin
      if FindString(Result[i].Name, DeletedStorages) then
      begin
        MarkDeleted(i, Result, 0);
        if Result[i].Color = DECOLOR_BLACK then
          PaintItBlack := true;
      
      end;
    
    end;
  
    FakeParent := 0;  //Now that we know the deletes, delete the nodes from the red/black tree.
    FixNode(Result, FakeParent);
    Assert(FakeParent = 0, 'Can''t delete root');
  except
    FreeAndNil(Result);
    raise;
  end;
end;

procedure TOle2File.PrepareForWrite(const OutStream: TStream; const OStreamName: UTF16String; const DeleteStorages: StringArray);
var
  DIRStartOfs: Int32;
  NewFat: TOle2FAT;
  DirSect: Int64;
  LastDirPos: Int32;
  IniPos: Int64;
  DirSector: ByteArray;
  DataSector: ByteArray;
  PaintItBlack: Boolean;
  DirEntries: TDirEntryList;
  CurrentDirPos: Int32;
  i: Int32;
  SType: STGTY;
  StreamSect: Int64;
  StreamSize: Int64;
  bRead: Int64;
  nd: ByteArray;
  LastMiniFatPos: Int32;
  MiniFatSect: Int64;
begin
  if PreparedForWrite then
    raise Exception.CreateFmt(ErrInvalidStream, ['']);
  
  DIRStartPos := -1;
  DIRStartOfs := -1;
  NewFat := TOle2FAT.Create(Header, nil);
  try
    LastDirPos := -1;
    IniPos := OutStream.Position;
    SetLength (DirSector, Header.SectorSize);
    FillChar(DirSector[0], System.Length(DirSector), 0);
    SetLength (DataSector, Header.SectorSize);
    FillChar(DataSector[0], System.Length(DataSector), 0);
    FreeAndNil(DIR);
    PaintItBlack := false;  //We are not going to mess with red/black things. If a recolor on the tree is needed, we will paint it all black.
    DirEntries := nil;
    try

      if System.Length(DeleteStorages) > 0 then  //Find all the storages and streams to delete, and patch the others not to point to them.
        DirEntries := ReadDirs(DeleteStorages, PaintItBlack);
  
      DirSect := Header.sectDirStart;
      OutStream.Seek(Header.SectToStPos(0, IniPos), soFromBeginning);  //Advance to the first sector.
      CurrentDirPos := 0;
       //Copy the Dir tree and their asociated streams. If stream is OStreamName, set its size to 0.
      while DirSect <> TOle2Header_ENDOFCHAIN do
      begin
        begin
          FStream.Seek(Header.SectToStPos(DirSect), soFromBeginning);
           //Read the whole sector, tipically 4 DIR entries.
          StreamRead(FStream, DirSector, 0, System.Length(DirSector), false);
          i := 0;
          while i < System.Length(DirSector) do
          try
            SType := TOle2Directory.GetType(DirSector, i);
            if PaintItBlack then
              TOle2Directory.SetColor(DirSector, i, DECOLOR_BLACK);
        
            if (DirEntries <> nil) and not DirEntries[CurrentDirPos].Deleted then
            begin
               //Fix the tree.
              TOle2Directory.SetLeftSid(DirSector, i, DirEntries[CurrentDirPos].LeftSid);
              TOle2Directory.SetRightSid(DirSector, i, DirEntries[CurrentDirPos].RightSid);
              TOle2Directory.SetChildSid(DirSector, i, DirEntries[CurrentDirPos].ChildSid);
            end;
        
            if (DirEntries <> nil) and DirEntries[CurrentDirPos].Deleted then
            begin
              TOle2Directory.Clear(DirSector, i);
            end
            else
              if ((SType = STGTY_STREAM) and ((TOle2Directory.GetSize(DirSector, i) >= Header.ulMiniSectorCutoff) or (TOle2Directory.GetName(DirSector, i) = OStreamName))) or (SType = STGTY_ROOT) then

                 //When ROOT, the stream is the MiniStream.  When Sectors reference the ministream, the data is not copied, as the whole ministream was copied with root.
                if TOle2Directory.GetName(DirSector, i) <> OStreamName then
                begin
                  StreamSect := TOle2Directory.GetSectStart(DirSector, i);  //Arrange FAT