sevenzipvcl.pas

TSevenZipVCL v.0.73 By Rainer Geigenberger. Component / Wrapper to use the 7zip dll. Easy to us

unit SevenZipVCL;
(*
   This Unit is under Mozilla Public Licence
    ( 
     - You can use this Unit for free in free, share and commercial application.
     - Mark clearly in your Readme or Help file that you use this unit/VCL with a link the 
       SevenZipVCL Homepage ( http://www.rg-software.de )
     - Any changes of the source must be publised ( Just send it to me :- ) [e-mail] )
    )


   TsevenZip by Ivo Andonov
   TSevenZipVCL by Rainer Geigenberger ( -> http://www.rg-software.de - [e-mail] )

   Thanks to:
    - Marko Kamin
    - Craig Peterson
    - Roberto
    - Erik Smith
    - Sergey Prokhorov
    - Flurin Honegger
    - Zach Saw
    - Guillaume Di Giusto 
	
   Dll Usage:
        For develpoment put the dll into the Windows directory
        Running the Application stand alone you can put the dll into the Application directory	
		
 History:

   Version 0.1
    - Start

   Version 0.2
    - Changed everything to Widestring
    - Added WideStringList_
    - Added TWideStringArray
    - Adding RelativePath works
    - Adding works with Recursive Directory
    - Adding with Wildcards ( only *.txt or something )
    - Progress for files ( With SetCompleted VCL interaction works )

   Version 0.3
    - Added time reading and writing

   Version 0.4
    - Added Extract
    - Added Test via Extract( True )
    - Set Filetime during extraction
    - Progress during extraction works ( small files will not be displayed alone )

   Version 0.5
    - Changes here and there
    - Clean up code

   Version 0.6
    - Changed "Extract all files"
    - Fixed bug in handling directories during extract
    - Attribute to extracted files works now
    - Fixed LastwriteTime during adding
    - Changed some functions

   Version 0.6.1
    - Some minor changes
    - Fixed some bugs
    - Added MaxProgrees to selected files
    - Added some missing GUID - not used now :- )

   Version 0.6.2
    - Compression strength could be set
    - Drive letter to Storepath option included
    - Changes made by Marko Kamin

   Version 0.6.3
    - Changed Archive options to new type Addopts
    - Solid settings works now

   Version 0.6.4
    - Implemented SFX creation

   Version 0.6.4b
    - LZMAStrength added

   Version 0.6.5
    - PPMD method added

   Version 0.6.5a
    - Fixed bug during listing of 0 byte files
   
   Version 0.6.5b
    - Fixed bug during creating files for extract/SFXarchive in Tstreamwriter 

   Version 0.6.5c
    - Fixed bug Creating SFX

   Version 0.6.6
    - Adding and extracting can be canceled

   Version 0.6.6a
    - Adding Extract without path

   Version 0.6.6c
    - Reading SFX
    - Number of files
    - New: IsSFX and SXFOffset
    - New: Function ConvertSFXto7z
    - New: Function Convert7ztoSFX

   Version 0.6.7
    - Added some Widestring function form TNTWare TNT Controls http://www.tntware.com/
    - New: OnExtractOverwrite - Do not work with Messageboxes right now
    - Include Extractoverwrite in Extractoption

   Version 0.6.7a
    - Changed constructor and destructor to avoid excaption - Thanks to Roberto jjw
    - Fixed Unicode bug during adding

   Version 0.6.7b
    - Clean up code. Thanks to Erik Smith
    - Rewrote Add function. Thanks to Erik Smith

   Version 0.6.7c
   - Multivolume support added - Thanks to Sergey Prokhorov
   - Begin password support - Thanks to Sergey Prokhorov

   Version 0.6.7e
   - Multivolume support improved
   - Clean up code

   Version 0.6.8a
   - Password implemented - Thanks to Sergey Prokhorov

   Version 0.6.8e
   - Implementation of 9x support started
   - Cleanup some comments

   Version 0.7.0
   - OpenarchiveCallback implemented
   - Encrypt filename option implemented

   Version 0.7.1
   - Fixed Bug in password support

   Version 0.7.1c
   - Changes by Flurin Honegger
   - Fixed 4GB limit (Filesize, Archive and Multivolume)
   - Added fileseek for Int64 (some Delphi versions do not take the right internal one)

   Version 0.7.2
   - added kpidLastAccessTime with value = 0
   - fixed bug in addrootdir during add

   Version 0.7.3
   - changed Getindexbyfilename -> InternalGetindexbyfilename by Zach Saw
   - added UseLog switch for smaller exe by Guillaume Di Giusto
   - Some other minor changes



  Author Shortcuts:   FHO    Flurin Honegger             [e-mail]
  Who    When          What
  --------------------------------------------------------------------------
  FHO    17.01.2007  - Need the filenames back when creating a multivolume
                       archive.

         20.01.2007  - Handles are of type cardinal. Comparison of the type
                       "if Returned_Handle <=0 then" are not correct.
                       Code changed to look like
                       "if Returned_Handle = INVALID_HANDLE_VALUE".

  FHO    21.01.2007  - Call to onmessage event handler references:
                        a.) Fxxx constant used
                        b.) Messagestrings collected in c7zipResMsg and
                            referenced by Fxxx constants

  FHO    22.01.2007  - Need better reason for error (GetLastError) return!
                       Corresponding code added.
                     - {$IFNDEF RegisterInThisUnit} added. I prefer to
                       register in a different "Collection unit".

  FHO    25.01.2007  - Resident non residient code realized with one
                       switch UseRes7zdll only.
                     - Comparison after LoadLibrary must be "<>0" and not
                       ">0". Similar problem as the one fixed 20.01.2007.

*)

(*
   Known Issues / Things ToDo:
   
    - No archive properties during listing
    - With Solid archives filenames and progress during extract comes very late
     ( at the end )
    - No deleting files from archive
    - If a wrong password is given a crash occures at position marked with
                     "//FHO crash at wrong pw 25.01.2007"
    - Multi volume sfx does not work.                 

  Please mark all changes with your sign and date e.g. rg 01.01.06
  and send it to me [e-mail]
*)


//----------------------------------------------------------------------
// Conditional switches
//----------------------------------------------------------------------

// {$WARN UNIT_PLATFORM OFF}    //works with higer Delphi versions
// {$WARN SYMBOL_PLATFORM OFF}  //works with higer Delphi versions


//----------------------------------------------------------------------
// Define to use Resfile with 7z.dll, no external dll, accessing through
//  BTMemoryModule                                             //FHO 25.01.2007
//----------------------------------------------------------------------
//{$DEFINE UseRes7zdll}

//----------------------------------------------------------------------
//Register within this unit or in external Collection
//----------------------------------------------------------------------
{$DEFINE RegisterInThisUnit}

//----------------------------------------------------------------------
// Dynamically load dll
//----------------------------------------------------------------------
//{$DEFINE DynaLoadDLL} // Not used now

// GDG 21.02.07 : added conditional switch to disable log functions and make final program smaller
//----------------------------------------------------------------------
// Define if you want to use log functions
//----------------------------------------------------------------------
//{$DEFINE UseLog}

interface
{$IFDEF UseRes7zdll}
  {$R 7za.res}
{$ENDIF}

uses
  Windows, SysUtils, Classes, ActiveX,comobj,filectrl
  {$IFDEF UseRes7zdll}
  ,BTMemoryModule
  {$ENDIF}
  ;

const
//7z internal consts

//Extract
  //NAskMode
  kExtract = 0;
  kTest    = 1;
  kSkip    = 2;

  //NOperationResult
  kOK                = 0;
  kUnSupportedMethod = 1;
  kDataError         = 2;
  kCRCError          = 3;

  FNAME_MAX32 = 512;

// SevenZIP onMessage Errorcode
  FNoError             = 0;
  FFileNotFound        = 1;
  FDataError           = 2;
  FCRCError            = 3;
  FUnsupportedMethod   = 4;
  FIndexOutOfRange     = 5;                                    //FHO 21.01.2007
  FUsercancel          = 6;
  FNoSFXarchive        = 7;
  FSFXModuleError      = 8;
  FSXFileCreationError = 9;                                    //FHO 21.01.2007
  FNoFilesToAdd        =10;                                    //FHO 21.01.2007
  FNoFileCreated       =11;

  c7zipResMsg:array[FNoError..FNoFileCreated] of string=       //FHO 21.01.2007
  { 0}('Success',                                              //FHO 21.01.2007
  { 1} 'File not found',                                       //FHO 21.01.2007
  { 2} 'Data Error',                                           //FHO 21.01.2007
  { 3} 'CRC Error',                                            //FHO 21.01.2007
  { 4} 'Unsupported Method',                                   //FHO 21.01.2007
  { 5} 'Index out of Range',                                   //FHO 21.01.2007
  { 6} 'User canceled operation',                              //FHO 21.01.2007
  { 7} 'File is not an 7z SFX archive',                        //FHO 21.01.2007
  { 8} 'SFXModule error ( Not found )',                        //FHO 21.01.2007
  { 9} 'Could not create SFX',                                 //FHO 21.01.2007
  {10} 'No files to add',                                      //FHO 21.01.2007
  {11} 'Could not create file'                                 //FHO 21.01.2007

       );                                                      //FHO 21.01.2007



const
  kpidNoProperty = 0;
  kpidHandlerItemIndex = 2;
  kpidPath = 3;
  kpidName = 4;
  kpidExtension = 5;
  kpidIsFolder = 6;
  kpidSize = 7;
  kpidPackedSize = 8;
  kpidAttributes = 9;
  kpidCreationTime = 10;
  kpidLastAccessTime = 11;
  kpidLastWriteTime = 12;
  kpidSolid = 13;
  kpidCommented = 14;
  kpidEncrypted = 15;
  kpidSplitBefore = 16;
  kpidSplitAfter = 17;
  kpidDictionarySize = 18;
  kpidCRC = 19;
  kpidType = 20;
  kpidIsAnti = 21;
  kpidMethod = 22;
  kpidHostOS = 23;
  kpidFileSystem = 24;
  kpidUser = 25;
  kpidGroup = 26;
  kpidBlock = 27;
  kpidComment = 28;
  kpidPosition = 29;

  kpidTotalSize = $1100;
  kpidFreeSpace = $1101;
  kpidClusterSize = $1102;
  kpidVolumeName = $1103;

  kpidLocalName = $1200;
  kpidProvider = $1201;
  kpidUserDefined = $10000;


//jjw 18.10.2006
type
  TCreateObjectFunc = function ( const clsid: PGUID; const iid: PGUID; out _out ): Integer; stdcall;


//----------------------------------------------------------------------------------------------------
//--------------Widestring Classes--------------------------------------------------------------------
//----------------------------------------------------------------------------------------------------

type
  TWideStringArray = array of WideString;

  TWideStringList_ = class( TObject )
   private