abcompnd.inc

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

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Abbrevia
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1997-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* ABBREVIA: AbCompnd.inc 3.05                           *}
{*********************************************************}
{* ABBREVIA: Compound File classes and component (Source)*}
{*   See AbCompnd.pas for the VCL header                 *}
{*   See AbQCmpnd.pas for the CLX header                 *}
{*********************************************************}

{$I AbDefine.inc}

{$IFDEF Version6}
  {$WARN SYMBOL_PLATFORM OFF}
{$ENDIF}

interface

uses
  Classes, SysUtils,
{$IFDEF UsingClx}
  QComCtrls,
{$ELSE}
  ComCtrls,
{$ENDIF}
  AbBase, AbConst, AbDfDec, AbDfEnc, AbDfBase;

const
  AbCompoundFileVersion = '3.1';                                {!!.03}

const
  {SystemBlock constants}
  sbSignatureSize       = 40;   {byte size of Signature field}
  sbVolumeLabelSize     = 40;   {byte size of Volume Label field}
  sbAllocationSizeSize  = 4;    {byte size of Allocation Size field}
  sbVersionSize         = 4;    {byte size of Version field}
  sbUpdateSize          = 1;    {byte size of Updating Flag field}

  {Total size of System Block}
  SizeOfSystemBlock = sbSignatureSize + sbVolumeLabelSize +
                      sbAllocationSizeSize + sbVersionSize + sbUpdateSize;

  {RootDir constants}
  rdEntryNameSize       = 28;  {byte size of Name field}
  rdEntryIDSize         = 4;   {byte size of EntryID field}
  rdParentFolderSize    = 4;   {byte size of ParentFolder field}
  rdEntryTypeSize       = 4;   {byte size of EntryType field}
  rdAttributesSize      = 4;   {byte size of Attributes field}
  rdStartBlockSize      = 4;   {byte size of StartBlock field}
  rdLastModifiedSize    = 8;   {byte size of LastModified field}
  rdSizeSize            = 4;   {byte size of UncompressedSize field}
  rdCompressedSizeSize  = 4;   {byte size of CompressedSize field}

  {Total size of a single Root Directory Entry}
  rdSizeOfDirEntry = rdEntryNameSize + rdEntryIDSize + rdParentFolderSize +
                     rdEntryTypeSize + rdAttributesSize + rdStartBlockSize +
                     rdLastModifiedSize + rdSizeSize + rdCompressedSizeSize;

  rdUnUsed              = -2;  {Constant used to flag an RD entry as unused}

  {Total size of a Root Directory entry}
  SizeOfRootDirBlock = rdEntryNameSize + rdEntryIDSize + rdParentFolderSize +
                       rdEntryTypeSize + rdAttributesSize + rdStartBlockSize +
                       rdLastModifiedSize + rdSizeSize + rdCompressedSizeSize;

  {FAT table constants}
  ftEndOfBlock          = -1;   {End of Block}
  ftUnusedBlock         = -2;   {Unused Block}

  {General constants}
  cfAllocationSize      = 512;  {Default AllocationSize (bytes)}

type
  ECompoundFileError = class(Exception);
  TrdEntryType = (etFolder, etFile);

  {dynamic array parameter for returning FAT chain sequences}
  type TFATChainArray = array of Integer;

  {forwards}
  TAbCompoundFile = class;
  TBeforeDirDeleteEvent = procedure(Sender : TAbCompoundFile; Dir : string;
                                    var AllowDelete : Boolean) of object;
  TBeforeDirModifiedEvent = procedure(Sender : TAbCompoundFile; Dir : string;
                                      var AllowModify : Boolean) of object;
  TBeforeFileDeleteEvent = procedure(Sender : TAbCompoundFile;FileName : string;
                                     var AllowDelete : Boolean) of object;
  TBeforeFileModifiedEvent = procedure(Sender : TAbCompoundFile;
                                       FileName : string; var AllowModify :
                                       Boolean) of object;

  TMultiNode = class(TObject)
  protected  {private}
    FParent     : Pointer;       {pointer to the parent node}
    FKey        : string;        {node identifier}
    FChildren   : TStringList;   {list for child keys & nodes}
    FData       : TObject;       {contained object}

    function GetChildren(Index : Integer) : TMultiNode;
    function GetChildCount : Integer;
  public
    constructor Create(const Key : string);
    destructor Destroy; override;
    function AddChild(const Key : string) : TMultiNode;
    procedure DeleteChild(Index : Integer);
    function DeleteChildByName(const ChildKey : string) : Boolean;
    function DeleteChildren : Boolean;
    function GetChild(Index : integer) : TMultiNode;
    function GetChildByName(const Key : string) : TMultiNode;
    function HasParent : Boolean;
    function HasChildren : Boolean;
    function Contains(const Key : string) : Boolean;
    property Parent : Pointer read FParent write FParent;
    property ChildCount : Integer read GetChildCount;
    property Children[Index : Integer] : TMultiNode read GetChildren;
    property Data : TObject read FData write FData;
    property Key : string read FKey write FKey;
  end;


  TMultiTree = class(TObject)
  protected  {private}
    FRoot        : TMultiNode;     {reference to root node}
    FCount       : Integer;        {count of nodes in the tree}
    FCurrentNode : TMultiNode;     {analogous to current directory}
    FSepChar     : Char;           {directory separator character}
    FIDCount     : Integer;        {counter incremented during preorder trav.}
                                   {(used to assign unique ID to each node)}

    procedure VisitSubNodesPost(Node : TMultiNode; ID : Integer);
    procedure VisitSubNodesPre(Node : TMultiNode; Strm : TStream);
    procedure VisitNode(Node : TMultiNode; Strm : TStream);
    procedure ParseDirStr(const Key : string; Lst : TStringList);      {!!.01}
    procedure PopulateSubNodes(ParentNode : TMultiNode;
                               TreeView : TTreeView; TreeNode : TTreeNode);
    procedure TraversePost(ID : Integer);
    procedure TraversePre(Strm : TStream);

  public
    constructor Create;
    destructor Destroy; override;
    function Insert(ParentNode : TMultiNode; const Key : string) : TMultiNode;
    function GetNode(const Key : string) : TMultiNode;
    function DeleteNode(const Key : string) : Boolean;
    procedure ChangeDir(const Key : string);
    function PopulateTreeView(TreeView : TTreeView) : Integer;
    property Root : TMultiNode read FRoot;
    property Count : Integer read FCount;
    property CurrentNode : TMultiNode read FCurrentNode;
    property SepChar : Char read FSepChar write FSepChar;
  end;


  TAbSystemBlock = class(TObject)
  protected {private}
    FSignature      : string;      {identifies the compound file structure}
    FVolumeLabel    : string;      {file identification in addition to filename}
    FAllocationSize : Integer;     {size of allocation block}
    FVersion        : string;      {version string identifier}
    FUpdating       : Boolean;     {internal processing indicator}

  {protected methods}
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure WriteToStream(Strm : TMemoryStream);

  {properties}
    property Signature : string read FSignature write FSignature;
    property VolumeLabel : string read FVolumeLabel write FVolumeLabel;
    property Updating : Boolean read FUpdating;
    property AllocationSize : Integer
      read FAllocationSize write FAllocationSize;
    property Version : string read FVersion;
  public
    constructor Create(VolLabel : string; AllocationSz : Integer);
  end;

  TAbDirectoryEntry = class(TObject)
  protected {private}
    FName           : string;           {name of file or folder}
    FEntryID        : Integer;          {unique ID for this dir. entry}
    FParentFolder   : LongInt;          {unique ID of parent folder}
    FEntryType      : TrdEntryType;     {folder or file}
    FAttributes     : LongInt;          {file system attributes}
    FStartBlock     : LongInt;          {starting allocation block}
    FLastModified   : TDateTime;        {last modification date/time}
    FSize           : LongInt;          {uncompressed file size}
    FCompressedSize : LongInt;          {compressed file size}

    procedure WriteToStream(Strm : TMemoryStream);
    function IsReadOnly : Boolean;
    function IsHidden : Boolean;
    function IsSysFile : Boolean;
    function IsVolumeID : Boolean;
    function IsDirectory : Boolean;
    function IsArchive : Boolean;
    function GetIsFree : Boolean;

  public
    constructor Create(AsFile : Boolean);

    property EntryName : string read FName write FName;
    property ParentFolder : LongInt read FParentFolder write FParentFolder;
    property Attributes : LongInt read FAttributes write FAttributes;
    property StartBlock : LongInt read FStartBlock write FStartBlock;
    property LastModified : TDateTime read FLastModified write FLastModified;
    property Size : LongInt read FSize write FSize;
    property CompressedSize : LongInt
      read FCompressedSize write FCompressedSize;
    property IsFree : Boolean read GetIsFree;
    property EntryType : TrdEntryType read FEntryType write FEntryType;
  end;


  TAbRootDir = class(TMultiTree)
    fAllocSize : Integer;
  protected {private}
    function AddFolder(FolderName : string) : TAbDirectoryEntry;
    function AddFile(FileName : string) : TAbDirectoryEntry;
    procedure DeleteFolder(FolderName : string);
    procedure DeleteFile(FileName : string);
    procedure WriteToStream(Strm : TMemoryStream);
    procedure GoToEntryID(ID : Integer);
  public
    constructor Create(VolLabel : string; AllocSize : Integer);
    destructor Destroy; override;
  end;


  TAbFATTable = class(TObject)
  protected {private}
    fFATArray  : Array of Integer;       {dynamic array for the FAT}
    fAllocSize : Integer;

    procedure WriteToStream(Strm : TMemoryStream);

  public
    constructor Create(AllocSize : Integer);
    destructor Destroy; override;
    function IsEndOfFile(Ndx : Integer) : Boolean;
    function IsUnUsed(Ndx : Integer) : Boolean;
    function GetNextUnusedBlock : Integer;
    procedure GetNewChain(NumBytes : Integer;
                          var ChainArray : TFATChainArray);
    procedure GetExistingChain(StartNdx : Integer;
                               var ChainArray : TFATChainArray);
    procedure ClearExistingChain(StartNdx : Integer);
    procedure GetRootDirChain(var ChainArray : TFATChainArray);
    procedure GetFATChain(var ChainArray : TFATChainArray);
    procedure GetNewRootDirChain(NumBytes : Integer;
                                 var ChainArray : TFATChainArray);
    procedure GetNewFATChain(NumBytes : Integer;
                             var ChainArray : TFATChainArray);
    procedure ClearRootDirChain;
    procedure ClearFATChain;
  end;


  TAbCompoundFile = class(TObject)
  protected {private}
    FSystemBlock : TAbSystemBlock;      {system block}
    FFATTable    : TAbFATTable;         {FAT table}
    FRootDir     : TAbRootDir;          {root directory}
    FDiskFile    : string;              {compound file name}
    FSizeOnDisk  : Integer;             {sum total of compressed sizes +
                                         uncompressed Sys, RootDir, & FAT blks}
    FStream      : TFileStream;         {Compound file stream (*.cf)}

    FOnAfterOpen          : TNotifyEvent;
    FOnBeforeClose        : TNotifyEvent;
    FOnBeforeDirDelete    : TBeforeDirDeleteEvent;
    FOnBeforeDirModified  : TBeforeDirModifiedEvent;
    FOnBeforeFileDelete   : TBeforeFileDeleteEvent;
    FOnBeforeFileModified : TBeforeFileModifiedEvent;

    function GetVolumeLabel : string;
    procedure SetVolumeLabel(Val : string);
    function GetDirectoryEntries : Integer;
    function GetSizeOnDisk : Integer;
    procedure PersistFileData(FileData : TStream;
                              var ChainArray : TFATChainArray);
    procedure PersistSystemBlock;
    procedure PersistRootDirBlock;
    procedure PersistFATBlock;
    procedure BuildSysBlock;
    procedure BuildFat;
    procedure BuildRootDir;
    procedure AddDirEntriesFromList(Lst : TStringList);

    procedure Defrag;                   {!!.03} {not implemented}
  public
    constructor Create(FileName : string; VolLabel : string;
                       AllocSize : Integer);
    destructor Destroy; override;
    procedure EnumerateFiles(Lst : TStringList);                       {!!.01}
    procedure EnumerateFolders(Lst : TStringList);                     {!!.01}
    procedure AddFile(FName : string; FileData : TStream; FileSize : Integer);
    function AddFolder(FName : string) : Boolean;
    procedure UpdateFile(FName : string; FData : TStream);
    procedure DeleteFile(FName : string);
    procedure DeleteFolder(FName : string);
    procedure Open(FName : string);
    function OpenFile(FileName : string; var Strm : TStream) : Integer;
    function PopulateTreeView(TreeView : TTreeView) : Integer;
    procedure PopulateSubNodes(ParentNode : TMultiNode;
                     TreeView : TTreeView; TreeNode : TTreeNode);
    procedure RenameFile(OrigName, NewName : string);
    procedure RenameFolder(OrigName, NewName : string);
    procedure SetCurrentDirectory(val : string);
    function GetCurrentDirectory : string;
    function GetAllocationSize : Integer;
    property CurrentDirectory : string
      read GetCurrentDirectory write SetCurrentDirectory;
    property DirectoryEntries : Integer read GetDirectoryEntries;
    property SizeOnDisk : Integer read GetSizeOnDisk;
    property Stream : TFileStream read FStream write FStream;


  published
    property VolumeLabel : string read GetVolumeLabel write SetVolumeLabel;
    property FileName : string read FDiskFile;
    property AllocationSize : Integer read GetAllocationSize;

    property OnAfterOpen : TNotifyEvent
      read FOnAfterOpen write FOnAfterOpen;
    property OnBeforeClose : TNotifyEvent
      read FOnBeforeClose write FOnBeforeClose;
    property OnBeforeDirDelete : TBeforeDirDeleteEvent
      read FOnBeforeDirDelete write FOnBeforeDirDelete;
    property OnBeforeDirModified : TBeforeDirModifiedEvent
      read FOnBeforeDirModified write FOnBeforeDirModified;
    property OnBeforeFileDelete : TBeforeFileDeleteEvent
      read FOnBeforeFileDelete write FOnBeforeFileDelete;
    property OnBeforeFileModified : TBeforeFileModifiedEvent
      read FOnBeforeFileModified write FOnBeforeFileModified;
  end;

implementation

{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
             {TMultiNode}
{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
constructor TMultiNode.Create(const Key : string);
  {- Creates and initializes a new node}