tmsuole2impl.pas

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

                  StreamSize := TOle2Directory.GetSize(DirSector, i);
                  bRead := 0;
                  if StreamSect <> TOle2Header_ENDOFCHAIN then
                    TOle2Directory.SetSectStart(DirSector, i, NewFat.Count);

                  while (StreamSect <> TOle2Header_ENDOFCHAIN) and (bRead < StreamSize) do
                  begin
                    begin
                       //Copy old Sector to New sector
                      FStream.Seek(Header.SectToStPos(StreamSect), soFromBeginning);
                      StreamRead(FStream, DataSector, 0, System.Length(DataSector), false);
                      OutStream.WriteBuffer(DataSector[0], System.Length(DataSector));
                      Assert((OutStream.Position - IniPos) = (Header.SectToStPos(NewFat.Count + 1) - Header.StartOfs), 'New Stream IO Error');
                       //Update The Fat
                      StreamSect := FAT.GetNextSector(StreamSect);
                      bRead:= bRead + Header.SectorSize;
                      if (StreamSect <> TOle2Header_ENDOFCHAIN) and (bRead < StreamSize) then
                        NewFat.Add(UInt32(NewFat.Count) + 1) else
                        NewFat.Add(TOle2Header_ENDOFCHAIN);

                    end;
                  end;
                end
                else
                begin
                  TOle2Directory.SetSectStart(DirSector, i, TOle2Header_ENDOFCHAIN);
                  TOle2Directory.SetSize(DirSector, i, 0);
                  SetLength (nd, TOle2Directory_DirectorySize);
                  System.Move(DirSector[i], nd[0], System.Length(nd));
                  DIR := TOle2Directory.Create(nd);
                  DIRStartOfs := i;
                end;

            Inc(CurrentDirPos);
          finally
            i:= i + TOle2Directory_DirectorySize;
          end;


           //Save the DIR Sector
          if DIRStartOfs >= 0 then
          begin
            DIRStartPos := OutStream.Position + DIRStartOfs;  //We must save the position here, just before writing the sector.
            DIRStartOfs := -1;
          end;

          OutStream.WriteBuffer(DirSector[0], System.Length(DirSector));
           //Add a new entry on the FAT for the new DIR sector.
          NewFat.Add(TOle2Header_ENDOFCHAIN);
          if LastDirPos > 0 then  //Chain the last FAT DIR point to this.
            NewFat[LastDirPos] := UInt32(NewFat.Count) - 1 else
            Header.sectDirStart := UInt32(NewFat.Count) - 1;
      
          DirSect := FAT.GetNextSector(DirSect);
          LastDirPos := NewFat.Count - 1;
        end;
      end;
    finally
      FreeAndNil(DirEntries);
    end;
    if DIR = nil then
      raise Exception.CreateFmt(ErrInvalidStream, ['']);
  
    LastMiniFatPos := -1;  //Copy the MiniFat
    MiniFatSect := Header.sectMiniFatStart;
    while MiniFatSect <> TOle2Header_ENDOFCHAIN do
    begin
      begin
        FStream.Seek(Header.SectToStPos(MiniFatSect), soFromBeginning);
         //Read the whole sector, tipically 128 MiniFat entries.
        StreamRead(FStream, DataSector, 0, System.Length(DataSector), false);
        OutStream.WriteBuffer(DataSector[0], System.Length(DataSector));
        NewFat.Add(TOle2Header_ENDOFCHAIN);
        if LastMiniFatPos > 0 then  //Chain the last FAT MiniFat point to this.
          NewFat[LastMiniFatPos] := UInt32(NewFat.Count) - 1 else
          Header.sectMiniFatStart := UInt32(NewFat.Count) - 1;
      
        MiniFatSect := FAT.GetNextSector(MiniFatSect);
        LastMiniFatPos := NewFat.Count - 1;
      end;
    end;
  except
    FreeAndNil(NewFat);
    raise;
  end;

   //Switch to the new Stream.
  FreeAndNil(FAT); 
  FAT := NewFat;
   //MiniFat stays the same.

  FStream := OutStream;
  Header.StartOfs := IniPos;
  FreeAndNil(SectorBuffer);
  SectorBuffer := TSectorBuffer.Create(Header, FStream);
  FreeAndNil(ROOT);  //No need for it when writing.
  PreparedForWrite := true;
  DIR.SectStart := NewFat.Count;
  DIR.ulSize := 0;
end;

procedure TOle2File.FinishStream();
var
  Data: ByteArray;
  OldDifSectorCount: Int64;
  DifSectorCount: Int64;
  FATSectorCount: Int64;
  FATEntryCount0: Int64;
  FatEntryDelta: Int64;
  OldFatEntryDelta: Int64;
  DifInHeader: ByteArray;
  StartDif: Int64;
  StartFat: Int64;
  f: Int32;
  i: Int32;
  DifSectorData: ByteArray;
  k: Int32;
  SectEnd: Int32;
  OneByte: byte;
  FourBytes: UInt32;
begin
  if not PreparedForWrite then
    exit;
  

   //Ensure Workbook has at least 4096 bytes, so it doesn't go to the MiniStream.
  if DIR.ulSize < Header.ulMiniSectorCutoff then
  begin
    SetLength (Data, Header.ulMiniSectorCutoff - DIR.ulSize);  //Filled with 0.
    FillChar(Data[0], System.Length(Data), 0);
    WriteRaw(Data, 0, System.Length(Data));
  end;
  

   //Fill the rest of the sector with 0s. 
  if (DIR.ulSize mod Header.SectorSize) > 0 then
  begin
    SetLength (Data, Header.SectorSize - (DIR.ulSize mod Header.SectorSize));  //Filled with 0.
    FillChar(Data[0], System.Length(Data), 0);
    WriteRaw(Data, 0, System.Length(Data));
    DIR.ulSize:= DIR.ulSize - System.Length(Data);  //This does not count to the final stream size
  end;
  
  //Fix Header. Fat count &sect, dif count & sect.  //Minifat and Dir are already fixed.
  DifSectorCount := 0;
  repeat  //Iterate to get the real dif/fat count. Adding a dif sector might a fat sector, so it might add another dif... luckily this will converge really fast.
  //Also, the fat sectors should be included on the fat count. If it weren't discrete, it would be a nice 3 x equation.
    FATEntryCount0 := ((FAT.Count + 1) + (((DIR.ulSize - 1) shr Header.uSectorShift) + 1)) + DifSectorCount;
    FatEntryDelta := ((FATEntryCount0 - 1) shr FAT.uFATEntryShift) + 1;  //first guess

    repeat
      OldFatEntryDelta := FatEntryDelta;
      FatEntryDelta := (((FATEntryCount0 + FatEntryDelta) - 1) shr FAT.uFATEntryShift) + 1;
     (* This converges, because FatEntryDelta>=OldFatEntryDelta
      * To prove Fed[n+1]>=Fed[n], lets begin... (n=0): Fed[0]=0 <= Fed[1]=(0+FEC0)/128.
      * (n=k):  if Fed[k]>=Fed[k-1] -> (n=k+1):  Fed[k+1]=(FEC0+Fed[n])/128
      * As Fed[n]>=Fed[n-1], FEC0>0 ->  (FEC0+Fed[n])/128)>=(FEC0+Fed[n-1])/128  ->
      *
      * Fed[n+1]>=(FEC0+Fed[n-1])/128=Fed[n]  ;-)
      *)
    until not (FatEntryDelta <> OldFatEntryDelta);



    FATSectorCount := (((FATEntryCount0 + FatEntryDelta) - 1) shr FAT.uFATEntryShift) + 1;
    OldDifSectorCount := DifSectorCount;
    if FATSectorCount > TOle2Header_DifsInHeader then
      DifSectorCount := ((FATSectorCount - TOle2Header_DifsInHeader) div (Header.SectorSize div 4 - 1)) + 1;  //The last diff entry is a pointer to the new diff sector, so we have 127 slots, not 128.

  until not (OldDifSectorCount <> DifSectorCount);
  Header.csectFat := UInt32(FATSectorCount);
  Header.csectDif := UInt32(DifSectorCount);
  if DifSectorCount > 0 then
    Header.sectDifStart := UInt32((FAT.Count + 1) + (((DIR.ulSize - 1) shr Header.uSectorShift) + 1)) else
    Header.sectDifStart := TOle2Header_ENDOFCHAIN;


   //Save DIR
  FStream.Seek(DIRStartPos, soFromBeginning);
  DIR.Save(FStream);

   //Save Header.
  FStream.Seek(Header.StartOfs, soFromBeginning);
  Header.Save(FStream);

   //Save DIF in header
  SetLength (DifInHeader, TOle2Header_DifEntries);
  FillChar(DifInHeader[0], System.Length(DifInHeader), 0);
  StartDif := (FAT.Count + 1) + (((DIR.ulSize - 1) shr Header.uSectorShift) + 1);
  StartFat := StartDif + DifSectorCount;

  if FATSectorCount <= TOle2Header_DifsInHeader then
    f := Int32(FATSectorCount) else
    f := TOle2Header_DifsInHeader;
  
  for i := 0 to f - 1 do
  begin
    FourBytes := UInt32(StartFat + i);
    System.Move(FourBytes, DifInHeader[i shl 2], 4);
  end;

   //Docs say there should be an endofchain at the last slot of the last dif sector, but there is none. Only unused sectors (FFFF)
  for i := f shl 2 to System.Length(DifInHeader) - 1 do
    DifInHeader[i] := 255;

  FStream.WriteBuffer(DifInHeader[0], System.Length(DifInHeader));
  SetLength (DifSectorData, Header.SectorSize);
  FillChar(DifSectorData[0], System.Length(DifSectorData), 0);
   //Save DIF Sectors.
  FStream.Seek(Header.SectToStPos(StartDif), soFromBeginning);
  for k := 0 to DifSectorCount - 1 do
  begin
    SectEnd := Int32(Header.SectorSize) - 4;
    if k = (DifSectorCount - 1) then
      SectEnd := Int32(((FATSectorCount - TOle2Header_DifsInHeader - 1) mod (Header.SectorSize div 4 - 1) + 1) shl 2);

    i := 0;
    while i < SectEnd do
    begin
      FourBytes := UInt32(((StartFat + (i shr 2)) + TOle2Header_DifsInHeader) + Int64(k) * (Header.SectorSize div 4 - 1));
      System.Move(FourBytes, DifSectorData[i], 4);
      i:= i + 4;
    end;

    i := SectEnd;
    while i < Int32(Header.SectorSize - 4) do
    begin
      System.Move(UInt32(TOle2Header_FREESECT), DifSectorData[i], 4);
      i:= i + 4;
    end;

    if k = (DifSectorCount - 1) then
      System.Move(UInt32(TOle2Header_FREESECT), DifSectorData[Header.SectorSize - 4], 4) else
      FourBytes := UInt32((StartDif + k) + 1);
      System.Move(FourBytes, DifSectorData[Header.SectorSize - 4], 4);

    FStream.WriteBuffer(DifSectorData[0], System.Length(DifSectorData));
  end;


   //Write FAT for unmodified storages/streams
  for k := 0 to FAT.Count - 1 do
  begin
    FourBytes := UInt32(FAT[k]);
    FStream.WriteBuffer(FourBytes, 4);
  end;

   //Write Stream FAT
  for k := 0 to ((DIR.ulSize - 1) shr Header.uSectorShift) + 1 - 1 do
  begin
    FourBytes := UInt32((FAT.Count + k) + 1);
    FStream.WriteBuffer(FourBytes, 4);
  end;

  FStream.WriteBuffer(UInt32(TOle2Header_ENDOFCHAIN), 4);

   //Write DIF FAT
  for k := 0 to DifSectorCount - 1 do
    FStream.WriteBuffer(UInt32(TOle2Header_DIFSECT), 4);

   //Write FAT FAT
  for k := 0 to FATSectorCount - 1 do
    FStream.WriteBuffer(UInt32(TOle2Header_FATSECT), 4);

   //Fill FAT sector with FF
  OneByte := $FF;
  for k := Int32(((StartFat + FATSectorCount) shl 2) mod Header.SectorSize) to Header.SectorSize - 1 do
    FStream.WriteBuffer(OneByte, 1);
end;

function TOle2File.Get_Length(): Int64;
begin
  if DIR = nil then
    Result := 0 else
    Result := DIR.ulSize;

end;

function TOle2File.Get_Position(): Int64;
begin
  if PreparedForWrite then
    begin Result := DIR.ulSize; exit; end;

  Result := StreamPos;
end;

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

  Result := StreamPos >= Length;
end;

function TOle2File.Get_FileName(): UTF16String;
begin
{$IFDEF FLX_FILESTREAM_HAS_FILENAME}
  if (FStream is TFileStream) then
    Result := (FStream as TFileStream).FileName else Result := '';
{$ELSE}
  Result := '';
{$ENDIF}
end;

{.$endregion}
{ UInt32List }


{$IFNDEF FLX_GENERICS}
procedure UInt32List.Add(const Item: UInt32);
begin
  FList.Add(Pointer(Item));
end;

constructor UInt32List.Create;
begin
  inherited;
  FList := TList.Create;
end;


destructor UInt32List.Destroy;
begin
  FreeAndNil(FList);
  inherited;
end;


function UInt32List.GetCapacity: Int32;
begin
  Result := FList.Capacity;
end;


function UInt32List.GetCount: Int32;
begin
  Result := FList.Count;
end;

function UInt32List.GetItems(const i: integer): UInt32;
begin
  Result := UInt32(FList[i]);
end;

procedure UInt32List.SetCapacity(const Value: Int32);
begin
  FList.Capacity := Value;
end;

procedure UInt32List.SetItems(const i: integer; const Value: UInt32);
begin
  FList[i] := Pointer(Value);
end;
{$ENDIF}

constructor TOneDirEntry.Create(const aName: UTF16String; const aLeftSid, aRightSid, aChildSid: Int32; const aColor: DECOLOR);
begin
  Name:=aName;
  LeftSid:=aLeftSid;
  RightSid:=aRightSid;
  ChildSid:=aChildSid;
  Deleted:=false;
  Color:=aColor;
end;


{$IFNDEF FLX_GENERICS}
{ TDirEntryList }

procedure TDirEntryList.Add(const Item: TOneDirEntry);
begin
  FList.Add(Item);
end;


constructor TDirEntryList.Create;
begin
  FList.Create;
  FList.OwnsObjects := true;
end;


destructor TDirEntryList.Destroy;
begin
  FreeAndNil(FList);
  inherited;
end;


function TDirEntryList.GetCount: Int32;
begin
  Result := FList.Count;
end;


function TDirEntryList.GetItems(const i: integer): TOneDirEntry;
begin
  Result := FList[i] as TOneDirEntry;
end;


procedure TDirEntryList.SetItems(const i: integer; const Value: TOneDirEntry);
begin
  FList[i] := Value;
end;
{$ENDIF}
end.