abcompnd.inc

Lazarus is a free and open source development tool for the FreePascal Compiler. The purpose of the p

  LstEntry : TAbDirectoryEntry;
  Entry    : TAbDirectoryEntry;
begin
  for i := 0 to Lst.Count - 1 do begin
    LstEntry := (Lst.Objects[i] as TAbDirectoryEntry);

    {locate parent folder}
    FRootDir.GoToEntryID(LstEntry.FParentFolder);

    {Add file or folder}
    if LstEntry.EntryType = etFolder then
      Entry := FRootDir.AddFolder(LstEntry.FName)
    else
      Entry := FRootDir.AddFile(LstEntry.FName);

    {assign values}
    Entry.FName := LstEntry.FName;
    Entry.FEntryID := LstEntry.FEntryID;
    Entry.FParentFolder := LstEntry.FParentFolder;
    Entry.FEntryType := LstEntry.FEntryType;
    Entry.FAttributes := LstEntry.FAttributes;
    Entry.FStartBlock := LstEntry.FStartBlock;
    Entry.FLastModified := LstEntry.FLastModified;
    Entry.FSize := LstEntry.FSize;
    Entry.FCompressedSize := LstEntry.FCompressedSize;
  end;
end;
{-----------------------------------------------------------------------------}
function TAbCompoundFile.AddFolder(FName : string) : Boolean;
  {- Adds a new folder (directory) to the compound file}
var
  EntryCount : Integer;
begin
  if ((FStream.Size + FSystemBlock.AllocationSize) >= MaxLongInt) then
    raise ECompoundFileError.Create(AbCmpndExceedsMaxFileSize);

  EntryCount := FRootDir.Count;
  FSystemBlock.BeginUpdate;
    try
      FRootDir.AddFolder(FName);
      PersistRootDirBlock;
      PersistFATBlock;
    finally
      FSystemBlock.EndUpdate;
    end;
  Result := ((FRootDir.Count - EntryCount) = 1);
end;
{-----------------------------------------------------------------------------}
procedure TAbCompoundFile.BuildFat;
  {- Extracts FAT from this string, writes it to DestStrm(TMemoryStream) and
     ultimately updates/persists the FAT table}
var
  Buff       : Array of Integer;
  IntBuff    : Array[0..0] of Integer;
  DestStrm   : TMemoryStream;
  i, CurrPos : Integer;
  NextBlock  : Integer;
begin
  DestStrm := TMemoryStream.Create;
  try
    {Dim Buff to allocation block size}
    SetLength(Buff, FSystemBlock.AllocationSize div SizeOf(Integer));

    {Clear Buff}
    for i := Low(Buff) to High(Buff) do
      Buff[i] := ftUnusedBlock;

    {read 1st FAT block into Buff -> Write Buff to DestStrm}
    FStream.Seek(2 * FSystemBlock.AllocationSize, soFromBeginning);
    FStream.Read(Buff[0], FSystemBlock.AllocationSize);
    DestStrm.Write(Buff[0], FSystemBlock.AllocationSize);

    {Determine next block of FAT chain}
    NextBlock := Buff[2];

    {read remaining FAT blocks if they exist}
    While NextBlock <> ftEndOfBlock do begin
      FStream.Seek((NextBlock) * FSystemBlock.AllocationSize, soFromBeginning);

      {Clear buff}
      for i := Low(Buff) to High(Buff) do
        Buff[i] := ftUnusedBlock;

      FStream.Read(Buff[0], FSystemBlock.AllocationSize);
      DestStrm.Write(Buff[0], FSystemBlock.AllocationSize);

      {Determine the next FAT block - we'll return to this position in stream}
      CurrPos := DestStrm.Position;
      DestStrm.Seek((NextBlock - 1) * SizeOf(Integer), soFromBeginning);
      DestStrm.Read(IntBuff[0], SizeOf(Integer));
      NextBlock := IntBuff[0];
      DestStrm.Seek(CurrPos, soFromBeginning);
    end;

    {Set length of and populate the FFATTable.fFATArray in mem structure}
    DestStrm.Seek(0, soFromBeginning);
    SetLength(FFATTable.fFATArray, DestStrm.Size div SizeOf(Integer));
    for i := 1 to DestStrm.Size div SizeOf(Integer) do begin
      DestStrm.Read(IntBuff[0], SizeOf(Integer));
      FFATTable.fFATArray[i-1] := IntBuff[0];
    end;
  finally
    DestStrm.Free;
  end;
  PersistFATBlock;
end;
{-----------------------------------------------------------------------------}
procedure TAbCompoundFile.BuildRootDir;
  {- Builds list of root directory entries & passes list to AddDirEntriesFromList}
var
  ChainArray : TFATChainArray;
  DestStrm   : TMemoryStream;
  Buff       : Array of Byte;
  i          : Integer;
  Entry      : TAbDirectoryEntry;
  Lst        : TStringList;

  {RootDirEntry buffers}
  EName     : Array[0..rdEntryNameSize - 1] of Char;
  EID       : Array[0..0] of Integer;
  EPF       : Array[0..0] of Integer;
  EType     : Array[0..0] of Integer;
  EAttrib   : Array[0..0] of Integer;
  EStartBlk : Array[0..0] of Integer;
  EMod      : Array[0..0] of TDateTime;
  ESz       : Array[0..0] of Integer;
  ECompSz   : Array[0..0] of Integer;
begin
  {Get RootDir FAT chain}
  FFATTable.GetRootDirChain(ChainArray);
  SetLength(Buff, FSystemBlock.AllocationSize);
  DestStrm := TMemoryStream.Create;
  Lst := TStringList.Create;
  Lst.Duplicates := dupAccept;
  Lst.Sorted := False;
  try
    {Read entire RotDir block to DestStrm}
    for i := 0 to High(ChainArray) do begin
      FStream.Seek(FSystemBlock.AllocationSize * ChainArray[i], soFromBeginning);
      FStream.Read(Buff[0], FSystemBlock.AllocationSize);
      DestStrm.Write(Buff[0], FSystemBlock.AllocationSize);
    end;

    {Reset DestStrm}
    DestStrm.Seek(0, soFromBeginning);

    {For all directory entries, read entry, create object, & add to Lst}
    for i := 0 to (DestStrm.Size div rdSizeOfDirEntry) - 1 do begin
      {read a single directory entry}
      DestStrm.Read(EName[0], rdEntryNameSize);
      if EName = '' then
        continue;
      DestStrm.Read(EID[0], SizeOf(Integer));
      DestStrm.Read(EPF[0], SizeOf(Integer));
      DestStrm.Read(EType[0], SizeOf(Integer));
      DestStrm.Read(EAttrib[0], SizeOf(Integer));
      DestStrm.Read(EStartBlk[0], SizeOf(Integer));
      DestStrm.Read(EMod[0], SizeOf(TDateTime));
      DestStrm.Read(ESz[0], SizeOf(Integer));
      DestStrm.Read(ECompSz[0], SizeOf(Integer));

      if EType[0] = 0 then
        Entry := TAbDirectoryEntry.Create(False)
      else
        Entry := TAbDirectoryEntry.Create(True);

      Entry.FName := EName;
      Entry.FEntryID := EID[0];
      Entry.FParentFolder := EPF[0];
      if EType[0] = 0 then
        Entry.FEntryType := etFolder
      else
        Entry.FEntryType := etFile;
      Entry.FAttributes := EAttrib[0];
      Entry.FStartBlock := EStartBlk[0];
      Entry.FLastModified := EMod[0];
      Entry.FSize := ESz[0];
      Entry.FCompressedSize := ECompSz[0];

      {Don't add an empty dir entry}
      if Entry.FName <> '' then
        Lst.AddObject(IntToStr(i), TObject(Entry));
    end;

  {Add individual root directory entries to RootDir structure maintaining seq.}
  AddDirEntriesFromList(Lst);
  finally
    DestStrm.Free;
    for i := 0 to Lst.Count - 1 do
      if Lst.Objects[i] <> nil then
        TAbDirectoryEntry(Lst.Objects[i]).Free;
    Lst.Free;
  end;

  {Save updates}
  PersistRootDirBlock;
  PersistFATBlock;
end;
{-----------------------------------------------------------------------------}
procedure TAbCompoundFile.BuildSysBlock;
  {- Constructs System block from the contents of FStream
     (used when opening an existing compound file)}
var
  Sig          : Array[0..sbSignatureSize - 1] of Char;
  VolLabel     : Array[0..sbVolumeLabelSize - 1] of Char;
  Version      : Array[0..sbVersionSize - 1] of Char;
  AllocationSz : Array[0..0] of Integer;
begin
  FStream.Seek(0, soFromBeginning);
  FStream.Read(Sig[0], sbSignatureSize);
  FStream.Read(VolLabel[0], sbVolumeLabelSize);
  FStream.Read(AllocationSz[0], sbAllocationSizeSize);
  FStream.Read(Version[0], sbVersionSize);

  FSystemBlock.Signature := Sig;
  FSystemBlock.VolumeLabel := VolLabel;
  FSystemBlock.AllocationSize := AllocationSz[0];
  FSystemBlock.FVersion := Version;
  PersistSystemBlock;
end;
{-----------------------------------------------------------------------------}
procedure TAbCompoundFile.Defrag;
  {- Optimizes disk storage}
begin
{ not implemeneted }
end;
{-----------------------------------------------------------------------------}
procedure TAbCompoundFile.DeleteFile(FName : string);
  {- Deletes the file from the RootDirectory and FAT blocks (data remains)}
var
  StartBlock  : Integer;
  Allow       : Boolean;
  AllowDirMod : Boolean;
begin
  Allow := True;
  AllowDirMod := True;

  if not FRootDir.CurrentNode.Contains(FName) then
    raise ECompoundFileError.Create(AbCmpndFileNotFound);

  if Assigned(FOnBeforeFileDelete) then
    FOnBeforeFileDelete(self, FName, Allow);

  if Assigned(FOnBeforeDirModified) then
    FOnBeforeDirModified(self, TMultiNode(FRootDir.CurrentNode.Parent).Key,
                         AllowDirMod);

  if (Allow and AllowDirMod) then begin
    StartBlock := TAbDirectoryEntry(FRootDir.GetNode(FName).FData).StartBlock;
    FFATTable.ClearExistingChain(StartBlock);

    FRootDir.DeleteFile(FName);
    PersistRootDirBlock;
    PersistFATBlock;
  end;
end;
{-----------------------------------------------------------------------------}
procedure TAbCompoundFile.DeleteFolder(FName : string);
  {- Deletes the folder from the RootDirectory block}
var
  Allow       : Boolean;
  AllowDirMod : Boolean;
begin
  Allow := True;
  AllowDirMod := True;

  if not FRootDir.CurrentNode.Contains(FName) then
    raise ECompoundFileError.Create(AbCmpndFileNotFound);

  if Assigned(FOnBeforeDirDelete) then
    FOnBeforeDirDelete(self, FName, Allow);

  if Assigned(FOnBeforeDirModified) then
    FOnBeforeDirModified(self, TMultiNode(FRootDir.CurrentNode.Parent).Key,
                         AllowDirMod);

  if (Allow and AllowDirMod) then begin
    FRootDir.DeleteFolder(FName);
    PersistRootDirBlock;
    PersistFATBlock;
  end;
end;
{-----------------------------------------------------------------------------}
procedure TAbCompoundFile.EnumerateFiles(Lst : TStringList);           {!!.01}
var
  i : Integer;
begin
  Lst.Clear;
  for i := 0 to FRootDir.CurrentNode.ChildCount - 1 do begin
    if (FRootDir.CurrentNode.GetChildren(i).Data as TAbDirectoryEntry).EntryType = etFile then
      Lst.Add((FRootDir.CurrentNode.GetChildren(i).Data as TAbDirectoryEntry).EntryName);
  end;
end;
{-----------------------------------------------------------------------------}
procedure TAbCompoundFile.EnumerateFolders(Lst : TStringList);         {!!.01}
var
  i : Integer;
begin
  Lst.Clear;
  for i := 0 to FRootDir.CurrentNode.ChildCount - 1 do begin
    if (FRootDir.CurrentNode.GetChildren(i).Data as TAbDirectoryEntry).EntryType = etFolder then
      Lst.Add((FRootDir.CurrentNode.GetChildren(i).Data as TAbDirectoryEntry).EntryName);
  end;
end;
{-----------------------------------------------------------------------------}
function TAbCompoundFile.GetAllocationSize : Integer;
  {- Returns the block allocation size used by the compound file}
begin
  result := FSystemBlock.AllocationSize;
end;
{-----------------------------------------------------------------------------}
function TAbCompoundFile.GetCurrentDirectory : string;
  {- Returns the current directory}
begin
  Result := FRootDir.CurrentNode.Key;
end;
{-----------------------------------------------------------------------------}
function TAbCompoundFile.GetDirectoryEntries : Integer;
  {- Returns the total number of directory entries (files and folders)}
begin
  Result := FRootDir.Count;
end;
{-----------------------------------------------------------------------------}
function TAbCompoundFile.GetSizeOnDisk : Integer;
  {- Returns the compound file size (FStream.Size)}
begin
  Result := FStream.Size;
end;
{-----------------------------------------------------------------------------}
function TAbCompoundFile.GetVolumeLabel : string;
  {- Returns the volume label of the compound file}
begin
  Result := FSystemBlock.VolumeLabel;
end;
{-----------------------------------------------------------------------------}
procedure TAbRootDir.GoToEntryID(ID : Integer);
  {- Traverses tree and sets the current node to the node whose EntryID = ID}
begin
  TraversePost(ID);
end;
{-----------------------------------------------------------------------------}
procedure TAbCompoundFile.Open(FName : string);
{- Opens an existing compound file and builds Sys, Root Dir, and FAT blocks}
var
  Sig : Array[0..sbSignatureSize - 1] of Char;
begin
  if FStream <> nil then
    FStream.Free;
  FStream := TFileStream.Create(FName, fmOpenReadWrite or fmShareDenyNone);

  {Ensure valid signature}
  FStream.Read(Sig[0], sbSignatureSize);
  if Sig <> 'AbCompoundFile' then begin
    raise ECompoundFileError.Create(AbCmpndInvalidFile);
    exit;
  end;

  FDiskFile := FName;
  {populate Compound File structure}
  BuildSysBlock;
  BuildFat;
  BuildRootDir;

  if Assigned(FOnAfterOpen) then
    FOnAfterOpen(self);
end;
{--------------------------------------------------------------------------