rsvk/Component/ResourceCompUnit.pas

unit ResourceCompUnit;
{reSource Component Unit
Component Front End for reSource Compression Engine

reSource v2.6
Copyright (C) 1998-2001 Victor Kasenda / gruv
http://go.to/gruv
email: vickas@singnet.com.sg


  USAGE:
  Drop the component onto the form to use it.
  Default name will be Resource1.
  To perform any action on the archive, use Resource1.ArchiveMan (Archive Manager)

  There are 2 ways to perform actions on archives:
    Type 1: To deal directly with ArchiveMan.
            This is the most efficient type and allows the fastest way to add/extract
            multiple files from archive.
    Type 2: Call CompressToFile, DecompressFromFile.
            This wraps ArchiveMan and is simple to use if only dealing with one file.

  ACTIONS: (Type 1)
  Before doing any action, set the parameters for ArchiveMan
    Resource1.ArchiveMan.TempDir := 'c:\temp';  // Set the Temporary Directory

  To Open an Archive:
    Resource1.ArchiveMan.OpenArchive(<ArchiveName>);

  To Close the Archive:
    Resource1.ArchiveMan.CloseArchive;

  To Add files:
    Resource1.ArchiveMan.AddFiles(FileList: TStrings; const infile_dir: string)
    There are 2 ways to send the FileList
      - If each entry in FileList has the full Path+Name, then infile_dir can be ''.
      - If each entry in FileList is only the name, then infile_dir must contain
        the path the files are in.

  To Extract the file:
    Before calling ExtractList, set the parameters for file extract:
      Resource1.ArchiveMan.dest_dir := 'c:\mydir'; // destination dir for extract

    Resource1.ArchiveMan.ExtractList(List: TList; var files_extracted, extracted_size: integer);

    List is a TList of TCentralFileHeader.
    The CentralFileHeader is gotten from Resource1.ArchiveMan.ArchiveFile.CentralDir[i],
    where i is the index of the file.
    So to add file index 2 to the extract list, call
    List.Add(Resource1.ArchiveMan.ArchiveFile.CentralDir[2]);
    Then call ExtractList(List, a, b)
    The files_extracted and extracted_size are returned values.

  To Delete files:
    Resource1.ArchiveMan.DeleteFiles
    All files that are flagged for deletion are removed.
    To flag a file for delete, set the Delete property in its CentralFileHeader entry.
    e.g. to delete file of index 2 and 5,
      Resource1.ArchiveMan.ArchiveFile.CentralDir[2].Deleted := true; // flag
      Resource1.ArchiveMan.ArchiveFile.CentralDir[5].Deleted := true; // flag
      Resource1.ArchiveMan.DeleteFiles;                               // actual process


      
  EVENTS:
  OnCentralDirChange
    - called when Resource1.ArchiveMan.ArchiveFile.CentralDir changes.
      use it to update the list of files in the archive.
  OnAddLog (for debugging)
    - called when ArchiveMan outputs verbose information on what it is doing.
      mainly used for debugging.
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  {CG}
  ArchiveManagerUnit, ArchiveHeadersUnit, StructsUnit;

type
  TResource = class(TComponent)
  private
    {function GetOnShowStatusMsg: TStrEvent;
    procedure SetOnShowStatusMsg(const Value: TStrEvent);}
    function GetOnCentralDirChange: TNotifyEvent;
    procedure SetOnCentralDirChange(const Value: TNotifyEvent);
    function GetOnAddLog: TStrEvent;
    procedure SetOnAddLog(const Value: TStrEvent);
  protected
    FArchiveMan: TArchiveManager;
  public
    property ArchiveMan: TArchiveManager read FArchiveMan;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    {Wrapper for ArchiveMan.
    To work on one file in one archive
    NOTE:
    - These do not require an archive to be opened. They can be called
    'immediately'.
    - Do not call ArchiveMan.OpenArchive when you use these procedures.
    
    See Help above for description.

    CompressToArchive:
    SourceFileNamePath - File to compress
    ArchiveNamePath - Archive to add to.
                      If it exists, the file will be Added to the existing archive.

    DecompressFromArchive:
    ArchiveNamePath - Full path to archive file
    DestPath - Destination dir to extract files to
    FileName - the name of the file to extract. Leave blank to extract all files (Default)
    }
    procedure CompressToArchive(SourceFileNamePath, ArchiveNamePath: string);
    procedure DecompressFromArchive(ArchiveNamePath, DestPath: string; ExtractFileName: string = '');

  published
    property OnCentralDirChange: TNotifyEvent read GetOnCentralDirChange write SetOnCentralDirChange;
    //property OnShowStatusMsg: TStrEvent read GetOnShowStatusMsg write SetOnShowStatusMsg;
    property OnAddLog: TStrEvent read GetOnAddLog write SetOnAddLog;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Compression', [TResource]);
end;


{ TResource }


constructor TResource.Create(AOwner: TComponent);
begin
  inherited;
  {if not (csDesigning in ComponentState) then
  begin}
    FArchiveMan := TArchiveManager.Create;
  {end;}
end;



destructor TResource.Destroy;
begin
  if Assigned(FArchiveMan) then FArchiveMan.Free;
  inherited;
end;

function TResource.GetOnAddLog: TStrEvent;
begin
  result := FArchiveMan.OnAddLog;
end;

function TResource.GetOnCentralDirChange: TNotifyEvent;
begin
  result := FArchiveMan.OnCentralDirChange;
end;

{function TResource.GetOnShowStatusMsg: TStrEvent;
begin
  result := FArchiveMan.OnShowStatusMsg;
end;}

procedure TResource.SetOnAddLog(const Value: TStrEvent);
begin
  FArchiveMan.OnAddLog := Value;
end;

procedure TResource.SetOnCentralDirChange(const Value: TNotifyEvent);
begin
  FArchiveMan.OnCentralDirChange := Value;
end;

{procedure TResource.SetOnShowStatusMsg(const Value: TStrEvent);
begin
  FArchiveMan.OnShowStatusMsg := Value;
end;}

{-------------------------------------------------------------------------------
  CompressToArchive
-------------------------------------------------------------------------------}
procedure TResource.CompressToArchive(SourceFileNamePath,
  ArchiveNamePath: string);
var
  FilesAdded: integer;
  list: TStringList;
begin
  {Algorithm:
   Open Archive
   Add the file
   Close Archive}
  if ArchiveMan.IsArchiveOpen then
  begin
    {Error Check: Cannot use when Archive is opened.
    We will open and close the Archive ourselves}
    Application.MessageBox('reSource: ArchiveMan cannot be opened to use CompressToArchive',
      'Error', MB_OK);
    exit;
  end;

  { Step 1: Open Archive }
  ArchiveMan.OpenArchive(ArchiveNamePath, false);

  Screen.Cursor := crHourGlass;
  try
    { Step 2: Add the file }
    // Construct a TStringList of files to add
    // We pass a nil in the folder because the full path is in list
    list := TStringList.Create;
    list.Add(SourceFileNamePath);
    FilesAdded := ArchiveMan.AddFiles(list, '');
    if (FilesAdded = 0) then
    begin
      Application.MessageBox('reSource.CompressToArchive: Error No Files Added',
        'Error', MB_OK);
      exit;
    end
    else
    begin
      Application.MessageBox('reSource.CompressToArchive: One file added to archive.',
        'Error', MB_OK);
      exit;
    end;

  finally
    { Step 3: Close the archive }
    if ArchiveMan.IsArchiveOpen then
      ArchiveMan.CloseArchive;
    Screen.Cursor := crDefault;      
  end;
end;

{-------------------------------------------------------------------------------
  DecompressFromArchive
-------------------------------------------------------------------------------}
procedure TResource.DecompressFromArchive(ArchiveNamePath, DestPath: string;
  ExtractFileName: string='');
var
  CFH: TCentralFileHeader;
  i, FilesExtracted, ExtractedSize: integer;
  CFHList: TList;
begin
  {Algorithm
  Check that the Archive exists before calling this.
  Open Archive
  if FileName <> '' then
    search for FileName and extract one file
  else
    extract all files in archive
  Close Archive
  }

  FilesExtracted := 0;
  ExtractedSize := 0;
  
  if not FileExists(ArchiveNamePath) then
  begin
    Application.MessageBox('reSource.DecompressFromArchive: Archive file does not exist.',
      'Error', MB_OK);
    exit;
  end;

  ArchiveMan.OpenArchive(ArchiveNamePath, true);
  Screen.Cursor := crHourGlass;
  try
    with ArchiveMan.ArchiveFile do
    begin
      ArchiveMan.dest_dir := IncludeTrailingBackslash(DestPath);
      {Search for file name in CentralFileHeader}
      if ExtractFileName <> '' then
      begin
        for i := 0 to CentralDir.Count-1 do
        begin
          CFH := TCentralFileHeader(CentralDir[i]);
          if CompareText(CFH.filename, ExtractFileName) = 0 then
          begin
            {Construct a CFHList with one CentralFileHeader (CFH) }
            CFHList := TList.Create;
            CFHList.Add(CFH);
            ArchiveMan.ExtractList(CFHList, FilesExtracted, ExtractedSize);
            CFHList.Free;
            break;
          end;
        end;
      end
      else
      begin
        {extract all files in archive.
        Add all the CentralDir CFH into CFHList}
        CFHList := TList.Create;
        for i := 0 to CentralDir.Count-1 do
          CFHList.Add(TCentralFileHeader(CentralDir[i]));
        ArchiveMan.ExtractList(CFHList, FilesExtracted, ExtractedSize);
        CFHList.Free;
      end;
    end;

    if FilesExtracted = 0 then
      ShowMessage('Error: No files extracted')
    else
      ShowMessage(IntToStr(FilesExtracted)+' file(s) extracted');

  finally
    if ArchiveMan.IsArchiveOpen then
      ArchiveMan.CloseArchive;
    Screen.Cursor := crDefault;      
  end;
end;


end.