lazarus-ccr/components/fpspreadsheet/source/common/uvirtuallayer_ole.pas

{
uvirtuallayer_ole.pas

Creates a virtual layer over a stream to access an Microsoft OLE document
using similar functionality as a regular file in a disk. It can create streams
and storages and, read and enumerate them.

Based in the TVirtualLayer class, so it can be stacked (mounted).

Status of operations:
* Enumerate streams and storages: Operative.
* Create stream:                  Currently only on "Root Folder".
* Create storage:                 Not working.
* Read stream:                    Operative.
* Delete stream:                  Not working.
* Delete storage:                 Not working.
* Attributes read:                Not working.
* Attributes write:               Not working.
* Regular streams:                Operative.
* Mini streams:                   Operative.
* Streams read/write concurrence: Not fully operative.
* Root directory coloring:        All are black.
* 32/64 bits:                     Not tested (mostly compliant).
* Multithreading:                 Not working (*1).
* Little endian platform:         Operative.
* Big endian platform:            Operative (tests needed).
* Create LE OLE files:            Operative.
* Create BE OLE files:            Not supported by default (use format func.).
* OLE bigger than 2 GB:           Not working.
* Known bugs:                     Streams multiple of sector size will have
                                  one sector allocated in excess.
* Whole status:                   Alpha (9 May 2009)

*1: Multithreading is not implemented by design in TVirtualLayer and its
    descendants will not be multithreading safe. This does not means that
    you can not use them in a Multithreading environment, but concurrent
    access to any layer from different threads at the same time will give
    unpredictable results. Basic blocking is provided by TVirtualLayer but
    this means that accesses will not be truly concurrent. Different layers
    will expose different stability when called from several threads at the
    same time, so in other words do not access virtual layers from different
    threads at the same time or the world could KBOOM! :)

OLE comments: OLE files, aka "Windows Compound Binary Format", presents some
              limitations. In version 3 they can not be bigger than 2 GB even
              when the storage format allows more than 2 TB. Sector size even
              when defined in the header it is tied to the "DllVersion" and not
              to the "FileVersion" which means version 3 = 512 bytes per sector
              and version 4 = 4096 bytes per sector. Version 4 should be able to
              read sectors of 512 bytes and 4096 but this point has not been
              tested as no version 4 real files to test has been found.

Related files:  uvirtuallayer_ole
                uvirtuallayer_ole_helpers
                uvirtuallayer_ole_types

AUTHORS: José Mejuto Porral
}
unit uvirtuallayer_ole;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  uvirtuallayer_types, uvirtuallayer,
  uvirtuallayer_ole_helpers, uvirtuallayer_ole_types;

type

  { TVirtualLayer_wincompound }

  TVirtualLayer_OLE=class(TVirtualLayer)
  private
    OpenedStreams: array of TWCBFOpenStream;
    FFATIndirect: TFATIndirect;

    procedure UseParameter(const Parameter);
    procedure SwapEndian_Record(var D: TWCBFStructuredStorageHeader);
    procedure SwapEndian_Record(var D: TWCBFStructuredStorageDirectoryEntry);
    Procedure NotImplemented();
    function ReadData(const Index: integer; const Buffer: PBYTE; const Size: int64): int64;
    function GetStorageFirstSID(const APath: UTF8String): SID;
    function GetStreamSID(const APath: UTF8String): SID;
    function FindFreeOpenFile(): integer;
    procedure DeleteSIDData(const ASID: SID);
    function CreateNewSID(const AType: etagSTGTY): SID;
    procedure InsertInDirectoryTree(const ASID,AMasterSID: SID);
  protected
    FDirectory: array of TWCBFStructuredStorageDirectoryEntry;

    function intfGetFreeSpace(const APath: UTF8String): int64; override;
    function intfIsWritableMedia(): Boolean; override;
    function intfFindList(const APath: UTF8String; const AMask: UTF8String): TVirtualLayer_FolderList; override;

    function intfOpenFile(const AFileName: UTF8String; const AMode: cardinal): TvlHandle; override;
    function intfCloseFile(const Handle: TvlHandle): Boolean; override;
    function intfRead(const Handle: TvlHandle; const Buffer: PBYTE; const Size: int64): int64; override;
    function intfSeek(const AHandle: TvlHandle; const APosition: int64; const Origin: word): int64; override;
    function intfGetFileSize(const AHandle: TvlHandle): int64; override;
    //Not implemented....
    function intfWrite(const Handle: TvlHandle; const Buffer: PBYTE; const Size: int64): int64; override;
    function intfSetFileSize(const AHandle: TvlHandle; const ANewFileSize: int64): Boolean; override;
    function intfDeleteFile(const AFileName: UTF8String): boolean; override;
    function intfMakeFolder(const AFolder: UTF8String): Boolean; override;
    function intfRemoveFolder(const AFolder: UTF8String): Boolean; override;
    //..Not implemented

  public
    procedure Format();
    function Initialize():boolean; override;
    procedure AfterConstruction; override;
    destructor Destroy(); override;
  end;

implementation

function HandleToIndex(const Handle: TvlHandle; out Index: integer): Boolean;
var
  X: PtrUInt;
begin
{$HINTS OFF}
  X:=PtrUInt(Handle);
{$HINTS ON}
  index:=X-1;
  if (Index<0) Then begin
    Result:=false;
  end else begin
    Result:=true;
  end;
end;

function IndexToHandle(const Index: integer): TvlHandle;
begin
{$HINTS OFF}
  Result:=TvlHandle(Index+1);
{$HINTS ON}
end;

{ TVirtualLayer_OLE }

{$HINTS OFF}
procedure TVirtualLayer_OLE.UseParameter(const Parameter);
begin
  //Do nothing
end;
{$HINTS ON}

procedure TVirtualLayer_OLE.SwapEndian_Record(var D: TWCBFStructuredStorageHeader);
var
  j: integer;
begin
{$IFDEF FPC}
  {$IFDEF FPC_LITTLE_ENDIAN}
  UseParameter(D);
  j:=0;
  UseParameter(j);
  {$ELSE}
  d._csectDif:=SwapEndian(d._csectDif);
  d._csectFat:=SwapEndian(d._csectFat);
  d._csectMiniFat:=SwapEndian(d._csectMiniFat);
  d._sectDifStart:=SwapEndian(d._sectDifStart);
  d._sectDirStart:=SwapEndian(d._sectDirStart);
  d._uMinorVersion:=SwapEndian(d._uMinorVersion);
  d._uDllVersion:=SwapEndian(d._uDllVersion);
  d._uByteOrder:=SwapEndian(d._uByteOrder);
  d._uSectorShift:=SwapEndian(d._uSectorShift);
  d._uMiniSectorShift:=SwapEndian(d._uMiniSectorShift);
  d._signature:=SwapEndian(d._signature);
  d._ulMiniSectorCutoff:=SwapEndian(d._ulMiniSectorCutoff);
  d._sectMiniFatStart:=SwapEndian(d._sectMiniFatStart);
  for j := 0 to 108 do begin
    d._sectFat[j]:=SwapEndian(d._sectFat[j]);
  end;
  {$ENDIF}
{$ENDIF}
end;

procedure TVirtualLayer_OLE.SwapEndian_Record(
  var D: TWCBFStructuredStorageDirectoryEntry);
var
  j: integer;
begin
{$IFDEF FPC}
  {$IFDEF FPC_LITTLE_ENDIAN}
  j:=0;
  UseParameter(D);
  UseParameter(j);
  {$ELSE}
  for j := 0 to 31 do begin
    d._ab[j]:=WChar(SwapEndian(WORD(d._ab[j])));
  end;

  d._time[0].dwHighDateTime:=SwapEndian(d._time[0].dwHighDateTime);
  d._time[0].dwLowDateTime :=SwapEndian(d._time[0].dwLowDateTime);
  d._time[1].dwHighDateTime:=SwapEndian(d._time[1].dwHighDateTime);
  d._time[1].dwLowDateTime :=SwapEndian(d._time[1].dwLowDateTime);

  d._cb           :=SwapEndian(d._cb);
  d._mse          :=SwapEndian(d._mse);
  d._bflags       :=SwapEndian(d._bflags);
  d._sidLeftSib   :=SwapEndian(d._sidLeftSib);
  d._sidRightSib  :=SwapEndian(d._sidRightSib);
  d._sidChild     :=SwapEndian(d._sidChild);
  d._dwUserFlags  :=SwapEndian(d._dwUserFlags);
  d._sectStart    :=SwapEndian(d._sectStart);
  d._ulSize       :=SwapEndian(d._ulSize);
  d._dptPropType  :=SwapEndian(d._dptPropType);
  {$ENDIF}
{$ENDIF}
end;

procedure TVirtualLayer_OLE.NotImplemented();
begin
  Raise Exception.Create('Not implemented or not possible to be done.');
end;

function TVirtualLayer_OLE.ReadData(const Index: integer;
  const Buffer: PBYTE; const Size: int64): int64;
begin
  Result:=FFATIndirect.ReadData(OpenedStreams[Index].Context,Buffer,Size);
end;

function TVirtualLayer_OLE.GetStorageFirstSID(const APath: UTF8String
  ): SID;
var
  Splitted: TStringList;
  j: integer;
  SIDChild: SID;

  function FindSiblingWithName(const AName: WideString; const AStartSibling: integer): SID;
  var
    n, ab: WideString;
  begin
    n := UpperCase(AName);
    ab := UpperCase(FDirectory[AStartSibling]._ab);
    if (n = ab) and (FDirectory[AStartSibling]._mse <> BYTE(STGTY_INVALID)) then
    begin
      Result:=FDirectory[AStartSibling]._sidChild;
    end else
    begin
      Result:=WINCOMPOUND_NOSID;
      if FDirectory[AStartSibling]._sidLeftSib<>WINCOMPOUND_NOSID then
        Result:=FindSiblingWithName(AName,FDirectory[AStartSibling]._sidLeftSib);
      if Result<>WINCOMPOUND_NOSID then
        exit;
      if FDirectory[AStartSibling]._sidRightSib<>WINCOMPOUND_NOSID then
        Result:=FindSiblingWithName(AName,FDirectory[AStartSibling]._sidRightSib);
    end;
  end;

begin
  Splitted:=TStringList.Create;
  SplitPath(APath,Splitted);
  if Length(FDirectory)<=1 then begin
    Splitted.Free;
    Result:=WINCOMPOUND_NOSID;
    Exit;
  end;
  SIDChild:=FDirectory[0]._sidChild;
  for j := 0 to Splitted.Count-1 do begin
    SIDChild:=FindSiblingWithName(UTF8Decode(Splitted[j]),SIDChild);
    if SIDChild=WINCOMPOUND_NOSID then break;
  end;
  Splitted.Free;
  Result:=SIDChild;
end;

function TVirtualLayer_OLE.GetStreamSID(const APath: UTF8String): SID;
var
  Splitted: TStringList;
  j: integer;
  SIDChild: SID;

  function FindSiblingWithName(const AName: WideString; const AStartSibling: integer): SID;
  var
    n, ab: WideString;
  begin
    n := UpperCase(AName);
    ab := UpperCase(FDirectory[AStartSibling]._ab);
    if (n = ab) and (FDirectory[AStartSibling]._mse <> BYTE(STGTY_INVALID)) then
      Result := AStartSibling
    else begin
      Result:=WINCOMPOUND_NOSID;
      if FDirectory[AStartSibling]._sidLeftSib<>WINCOMPOUND_NOSID then
        Result:=FindSiblingWithName(AName,FDirectory[AStartSibling]._sidLeftSib);
      if Result<>WINCOMPOUND_NOSID then
        exit;
      if FDirectory[AStartSibling]._sidRightSib<>WINCOMPOUND_NOSID then
        Result:=FindSiblingWithName(AName,FDirectory[AStartSibling]._sidRightSib);
    end;
  end;

begin
  Splitted:=TStringList.Create;
  SplitPath(APath,Splitted);
  if Length(FDirectory)<=1 then begin
    Splitted.Free;
    Result:=WINCOMPOUND_NOSID;
    Exit;
  end;
  SIDChild:=0;
  for j := 0 to Splitted.Count-1 do begin
    SIDChild:=FDirectory[SIDChild]._sidChild;
    SIDChild:=FindSiblingWithName(UTF8Decode(Splitted[j]),SIDChild);
    if SIDChild=WINCOMPOUND_NOSID then break;
  end;
  Splitted.Free;
  Result:=SIDChild;
end;

function TVirtualLayer_OLE.intfFindList(const APath: UTF8String;
  const AMask: UTF8String): TVirtualLayer_FolderList;
var
  LI: TVirtualLayer_FolderList;
  Mask: TMaskFile;
  SSID: SID;
  function AddNamesWithSID(const AStartSibling: SID): SID;
  var
//    Name: WideString;  // wp: was
    Name: String;
    VI: TVirtualLayer_Item;
  begin
    Name:=UTF8Encode(wideString(FDirectory[AStartSibling]._ab));
    if Mask.Matches(Name) Then begin
      VI:=TVirtualLayer_Item.Create;
      VI.Name:=Name;
      if FDirectory[AStartSibling]._mse=integer(STGTY_STORAGE) then begin
        //It is a "folder"
        VI.IsFolder:=true;
      end else begin
        VI.Size:=FDirectory[AStartSibling]._ulSize;
        VI.IsFolder:=false;
      end;
      LI.Add(VI);
    end;
    Result:=WINCOMPOUND_NOSID;
    if FDirectory[AStartSibling]._sidLeftSib<>WINCOMPOUND_NOSID then begin
      Result:=AddNamesWithSID(FDirectory[AStartSibling]._sidLeftSib);
    end;
    if FDirectory[AStartSibling]._sidRightSib<>WINCOMPOUND_NOSID then begin
      Result:=AddNamesWithSID(FDirectory[AStartSibling]._sidRightSib);
    end;
  end;

begin
  //Find the storage SID for the path...
  SSID:=GetStorageFirstSID(APath);
  if SSID=WINCOMPOUND_NOSID then begin
    LI:=TVirtualLayer_FolderList.Create(APath);
    Result:=LI; //Empty items list
    Exit;
  end;

  Mask:=TMaskFile.Create(AMask);
  LI:=TVirtualLayer_FolderList.Create(APath);

  AddNamesWithSID(SSID);

  Mask.Free;
  Result:=Li;
end;

function TVirtualLayer_OLE.intfOpenFile(const AFileName: UTF8String;
  const AMode: cardinal): TvlHandle;
var
  SSID,ParentSID: SID;
  CurHandle: TWCBFOpenStream;
  Index: integer;
  Path,StreamName: UTF8String;
begin
  SSID:=GetStreamSID(AFileName);
  if SSID=WINCOMPOUND_NOSID then begin
    //Stream not found
    if AMode<>fmCreate then begin
      //It should not be created
      Result:=nil;
      Exit;
    end;
  end;
  if AMode=fmCreate then begin
    FFATIndirect.DirtyMedia:=true;
    if SSID<>WINCOMPOUND_NOSID then begin
      //File already exists, so clear all the FAT links and adjust size to cero
      DeleteSIDData(SSID);
      with FDirectory[SSID] do begin
        _sectStart:=SECT_ENDOFCHAIN;
        _ulSize:=0;
      end;
    end else begin
      //Create a new SID and link it to the tree...
      SplitFileNamePath(AFileName,Path,StreamName);
      SSID:=CreateNewSID(STGTY_STREAM);
      FDirectory[SSID]._ab:=UTF8Decode(StreamName);
      FDirectory[SSID]._cb:=(Length(UTF8Decode(StreamName))+1)*SizeOf(WChar);
      ParentSID:=GetStreamSID(Path);
      if FDirectory[ParentSID]._sidChild=WINCOMPOUND_NOSID then begin
        //This one is the first entry in this storage.
        FDirectory[ParentSID]._sidChild:=SSID;
      end else begin
        //There are already some entries in this storage, explore the tree
        //and insert the new SID in the right position.
        InsertInDirectoryTree(SSID,FDirectory[ParentSID]._sidChild);
      end;
    end;
  end;

  CurHandle.Handle:=SSID;
  CurHandle.Context:=FFATIndirect.OpenStream(FDirectory[SSID]._sectStart,FDirectory[SSID]._ulSize,AMode);
  Index:=FindFreeOpenFile();
  if Index=integer(feInvalidHandle) then begin
    Index:=Length(OpenedStreams);
    SetLength(OpenedStreams,Index+1);
  end;
  OpenedStreams[Index]:=CurHandle;

  Result:=IndexToHandle(Index);
end;

function TVirtualLayer_OLE.intfCloseFile(const Handle: TvlHandle
  ): Boolean;
var
  Index: integer;
begin
  if not HandleToIndex(Handle,Index) Then begin
    Result:=false;
  end else begin
    if Index>High(OpenedStreams) then begin
      Result:=false;
    end else begin
      FFATIndirect.CloseStream(OpenedStreams[Index].Context);
      FDirectory[OpenedStreams[Index].Handle]._sectStart:=OpenedStreams[Index].Context.FATFirstIndex;
      FDirectory[OpenedStreams[Index].Handle]._ulSize:=OpenedStreams[Index].Context.Size;
      OpenedStreams[Index].Handle:=WINCOMPOUND_NOSID;
      OpenedStreams[Index].Context.FATFirstIndex:=SECT_ENDOFCHAIN;
      OpenedStreams[Index].Context.FATIndex:=SECT_ENDOFCHAIN;
      OpenedStreams[Index].Context.Size:=0;
      OpenedStreams[Index].Context.Position:=0;
      Result:=true;
    end;
  end;
end;

function TVirtualLayer_OLE.intfSeek(const AHandle: TvlHandle;
  const APosition: int64; const Origin: word): int64;
var
  index: Integer;
begin
  if not HandleToIndex(AHandle,Index) Then begin
    Result:=-1;
    Exit;
  end;
  Result:=FFATIndirect.StreamSeekPosition(OpenedStreams[Index].Context,APosition,TSeekOrigin(Origin));
end;

function TVirtualLayer_OLE.intfRead(const Handle: TvlHandle;
  const Buffer: PBYTE; const Size: int64): int64;
var
  index: integer;
begin
  if not HandleToIndex(Handle,Index) then begin
    Result:=0;
    Exit;
  end;
  result:=FFATIndirect.ReadData(OpenedStreams[index].Context,Buffer,Size);
end;

function TVirtualLayer_OLE.intfWrite(const Handle: TvlHandle;
  const Buffer: PBYTE; const Size: int64): int64;
var
  index: integer;
begin
  if not HandleToIndex(Handle,Index) then begin
    Result:=0;
    Exit;
  end;
  result:=FFATIndirect.WriteData(OpenedStreams[index].Context,Buffer,Size);
end;

function TVirtualLayer_OLE.intfGetFileSize(const AHandle: TvlHandle
  ): int64;
var
  Index: integer;
begin
  if not HandleToIndex(AHandle,Index) then begin
    Result:=0;
    Exit;
  end;
  Result:=FDirectory[OpenedStreams[index].Handle]._ulSize;
end;

function TVirtualLayer_OLE.intfSetFileSize(const AHandle: TvlHandle;
  const ANewFileSize: int64): Boolean;
begin
  UseParameter(AHandle);UseParameter(ANewFileSize);
  NotImplemented();
  Result:=false;
end;

function TVirtualLayer_OLE.intfDeleteFile(const AFileName: UTF8String
  ): boolean;
begin
  UseParameter(AFileName);
  NotImplemented();
  Result:=false;
end;

function TVirtualLayer_OLE.intfMakeFolder(const AFolder: UTF8String
  ): Boolean;
begin
  UseParameter(AFolder);
  NotImplemented();
  Result:=false;
end;

function TVirtualLayer_OLE.intfRemoveFolder(const AFolder: UTF8String
  ): Boolean;
begin
  UseParameter(AFolder);
  NotImplemented();
  Result:=false;
end;

procedure TVirtualLayer_OLE.AfterConstruction;
begin
  inherited AfterConstruction;
  FFATIndirect:=TFATIndirect.Create(FVirtualLayerStream);
end;

procedure TVirtualLayer_OLE.Format();
begin
  FFATIndirect.Initialize(true);
  FFATIndirect.Free;
  FFATIndirect := TFATIndirect.Create(FVirtualLayerStream);
  Self.Initialize();
end;

function TVirtualLayer_OLE.intfGetFreeSpace(const APath: UTF8String
  ): int64;
begin
  //This is a quite large operation, all FAT sectors must be
  //loaded and look for USED ones and discount them for the
  //maximun theorical which is:
  // Sectors=4294967280
  // SectorsForFATs=Sectors div FATEntriesPerSect + 109
  // SectorsInDIFs=SectorsForFATs div (FATEntriesPerSect-1)
  // .......
  // Too complex, so use the maximun theorical which is
  // Sectors * SectorSize which taken default settings is
  // 2,199,023,247,360 bytes or roughly around 2.2 TeraBytes.
  // but due usual desing flaws version 3 files are limited
  // to 2 GB and version 4 (4 Kb sectors) are limited to 512 GB.
  UseParameter(APath);
  Result:=0;
end;

function TVirtualLayer_OLE.intfIsWritableMedia(): Boolean;
begin
  Result:=true;
end;

function TVirtualLayer_OLE.FindFreeOpenFile(): integer;
var
  j: integer;
begin
  for j := 0 to High(OpenedStreams) do begin
    if OpenedStreams[j].Handle=WINCOMPOUND_NOSID Then begin
      Result:=j;
      Exit;
    end;
  end;
  Result:=integer(feInvalidHandle);
end;

procedure TVirtualLayer_OLE.DeleteSIDData(const ASID: SID);
begin
  If FFATIndirect.IsSizeInMiniFAT(FDirectory[ASID]._ulSize) then begin
    FFATIndirect.ResetMiniFATLinkage(FDirectory[ASID]._sectStart,SECT_FREESECT);
  end else begin
    FFATIndirect.ResetFATLinkage(FDirectory[ASID]._sectStart,SECT_FREESECT);
  end;
  //TODO: Resync handles to this SID.
end;

function TVirtualLayer_OLE.CreateNewSID(const AType: etagSTGTY): SID;
var
  j: SizeUint;
  procedure SetDefaults(var D: TWCBFStructuredStorageDirectoryEntry);
  begin
    FillByte(D,Sizeof(D),0);
    D._mse:=BYTE(AType);
    D._sectStart:=SECT_ENDOFCHAIN;
    D._bflags:=BYTE(DE_BLACK); //All are blacks in this implement.
    D._cb:=2; //NULL string
    D._sidChild:=WINCOMPOUND_NOSID;
    D._sidLeftSib:=WINCOMPOUND_NOSID;
    D._sidRightSib:=WINCOMPOUND_NOSID;
    //Ths other fields are zero.
  end;
begin
  for j := 0 to High(FDirectory) do begin
    if FDirectory[j]._mse=BYTE(STGTY_INVALID) then begin
      //Reuse this entry and blank it
      SetDefaults(FDirectory[j]);
      Result:=j;
      Exit;
    end;
  end;
  j:=Length(FDirectory);
  SetLength(FDirectory,j+1);
  SetDefaults(FDirectory[j]);
  Result:=j;
end;

procedure TVirtualLayer_OLE.InsertInDirectoryTree(const ASID,
  AMasterSID: SID);
begin
  if FDirectory[ASID]._ab > FDirectory[AMasterSID]._ab then begin
    if FDirectory[AMasterSID]._sidLeftSib=WINCOMPOUND_NOSID then begin
      FDirectory[AMasterSID]._sidLeftSib:=ASID;
    end else begin
      InsertInDirectoryTree(ASID,FDirectory[AMasterSID]._sidLeftSib);
    end;
  end else begin
    if FDirectory[AMasterSID]._sidRightSib=WINCOMPOUND_NOSID then begin
      FDirectory[AMasterSID]._sidLeftSib:=ASID;
    end else begin
      InsertInDirectoryTree(ASID,FDirectory[AMasterSID]._sidRightSib);
    end;
  end;
end;

function TVirtualLayer_OLE.Initialize(): boolean;
var
  Dir: TWCBFStructuredStorageDirectoryEntry;
  DirEntry: integer;
  EffectiveRead: SizeInt;
begin
  if not FFATIndirect.Initialize(false) then begin
    //Unable to initialize component.
    Result:=false;
    exit;
  end;
  
  SetLength(OpenedStreams,1);
  OpenedStreams[0].Handle:=0;
  OpenedStreams[0].Context:=FFATIndirect.DirectoryContext;
  while true do begin
    EffectiveRead:=FFATIndirect.ReadData(FFATIndirect.DirectoryContext,@Dir,Sizeof(Dir));
    SwapEndian_Record(Dir);
    if EffectiveRead=Sizeof(Dir) Then begin
      if Dir._cb>0 then begin
        //Load all, as even "deleted" entries must be preserved as the
        //SID (index in dir) is constant for all the file life (of course
        //they can be renumbered, but better do it in the save process).
        DirEntry:=Length(FDirectory);
        SetLength(FDirectory,DirEntry+1);
        FDirectory[DirEntry]:=Dir;
      end else begin
        //Empty name means end of dir.
        Break;
      end;
    end else begin
      break;
    end;
  end;
  if Length(FDirectory)>0 then Result:=true else Result:=false;
end;

destructor TVirtualLayer_OLE.Destroy();
var
  j: SizeUint;
  EmptyDir: TWCBFStructuredStorageDirectoryEntry;
begin
  if FFATIndirect.DirtyMedia Then begin
    //Update Root entry values
    FDirectory[0]._sectStart:=FFATIndirect.MiniFATDataContext.FATFirstIndex;
    FDirectory[0]._ulSize:=FFATIndirect.MiniFATDataContext.Size;
    FFATIndirect.StreamSeekPosition(FFATIndirect.DirectoryContext,0,soBeginning);
    for j := 0 to High(FDirectory) do begin
      FFATIndirect.WriteData(FFATIndirect.DirectoryContext,@FDirectory[j],sizeof(FDirectory[j]));
    end;
    EmptyDir._sidRightSib:=0; //Avoid uninitialize hint.
    FillByte(EmptyDir,sizeof(EmptyDir),0);
    FFATIndirect.WriteData(FFATIndirect.DirectoryContext,@EmptyDir,sizeof(EmptyDir));
  end;
  FreeAndNIL(FFATIndirect);
  inherited Destroy();
end;

end.