Advertisement
Guest User

Untitled

a guest
Sep 20th, 2014
217
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 118.94 KB | None | 0 0
  1. unit SevenZipVCL;
  2. (*
  3.    This Unit is under Mozilla Public Licence
  4.     (
  5.      - You can use this Unit for free in free, share and commercial application.
  6.      - Mark clearly in your Readme or Help file that you use this unit/VCL with a link the
  7.        SevenZipVCL Homepage ( http://www.rg-software.de )
  8.      - Any changes of the source must be publised ( Just send it to me :- ) SevenZipVCL@rg-software.de )
  9.     )
  10.  
  11.  
  12.    TsevenZip by Ivo Andonov
  13.    TSevenZipVCL by Rainer Geigenberger ( -> http://www.rg-software.de - SevenZipVCL@rg-software.de )
  14.  
  15.    Thanks to:
  16.     - Marko Kamin
  17.     - Craig Peterson
  18.     - Roberto
  19.     - Erik Smith
  20.     - Sergey Prokhorov
  21.     - Flurin Honegger
  22.     - Zach Saw
  23.     - Guillaume Di Giusto
  24.    
  25.    Dll Usage:
  26.         For develpoment put the dll into the Windows directory
  27.         Running the Application stand alone you can put the dll into the Application directory 
  28.        
  29.  History:
  30.  
  31.    Version 0.1
  32.     - Start
  33.  
  34.    Version 0.2
  35.     - Changed everything to Widestring
  36.     - Added WideStringList_
  37.     - Added TWideStringArray
  38.     - Adding RelativePath works
  39.     - Adding works with Recursive Directory
  40.     - Adding with Wildcards ( only *.txt or something )
  41.     - Progress for files ( With SetCompleted VCL interaction works )
  42.  
  43.    Version 0.3
  44.     - Added time reading and writing
  45.  
  46.    Version 0.4
  47.     - Added Extract
  48.     - Added Test via Extract( True )
  49.     - Set Filetime during extraction
  50.     - Progress during extraction works ( small files will not be displayed alone )
  51.  
  52.    Version 0.5
  53.     - Changes here and there
  54.     - Clean up code
  55.  
  56.    Version 0.6
  57.     - Changed "Extract all files"
  58.     - Fixed bug in handling directories during extract
  59.     - Attribute to extracted files works now
  60.     - Fixed LastwriteTime during adding
  61.     - Changed some functions
  62.  
  63.    Version 0.6.1
  64.     - Some minor changes
  65.     - Fixed some bugs
  66.     - Added MaxProgrees to selected files
  67.     - Added some missing GUID - not used now :- )
  68.  
  69.    Version 0.6.2
  70.     - Compression strength could be set
  71.     - Drive letter to Storepath option included
  72.     - Changes made by Marko Kamin
  73.  
  74.    Version 0.6.3
  75.     - Changed Archive options to new type Addopts
  76.     - Solid settings works now
  77.  
  78.    Version 0.6.4
  79.     - Implemented SFX creation
  80.  
  81.    Version 0.6.4b
  82.     - LZMAStrength added
  83.  
  84.    Version 0.6.5
  85.     - PPMD method added
  86.  
  87.    Version 0.6.5a
  88.     - Fixed bug during listing of 0 byte files
  89.    
  90.    Version 0.6.5b
  91.     - Fixed bug during creating files for extract/SFXarchive in Tstreamwriter
  92.  
  93.    Version 0.6.5c
  94.     - Fixed bug Creating SFX
  95.  
  96.    Version 0.6.6
  97.     - Adding and extracting can be canceled
  98.  
  99.    Version 0.6.6a
  100.     - Adding Extract without path
  101.  
  102.    Version 0.6.6c
  103.     - Reading SFX
  104.     - Number of files
  105.     - New: IsSFX and SXFOffset
  106.     - New: Function ConvertSFXto7z
  107.     - New: Function Convert7ztoSFX
  108.  
  109.    Version 0.6.7
  110.     - Added some Widestring function form TNTWare TNT Controls http://www.tntware.com/
  111.     - New: OnExtractOverwrite - Do not work with Messageboxes right now
  112.     - Include Extractoverwrite in Extractoption
  113.  
  114.    Version 0.6.7a
  115.     - Changed constructor and destructor to avoid excaption - Thanks to Roberto jjw
  116.     - Fixed Unicode bug during adding
  117.  
  118.    Version 0.6.7b
  119.     - Clean up code. Thanks to Erik Smith
  120.     - Rewrote Add function. Thanks to Erik Smith
  121.  
  122.    Version 0.6.7c
  123.    - Multivolume support added - Thanks to Sergey Prokhorov
  124.    - Begin password support - Thanks to Sergey Prokhorov
  125.  
  126.    Version 0.6.7e
  127.    - Multivolume support improved
  128.    - Clean up code
  129.  
  130.    Version 0.6.8a
  131.    - Password implemented - Thanks to Sergey Prokhorov
  132.  
  133.    Version 0.6.8e
  134.    - Implementation of 9x support started
  135.    - Cleanup some comments
  136.  
  137.    Version 0.7.0
  138.    - OpenarchiveCallback implemented
  139.    - Encrypt filename option implemented
  140.  
  141.    Version 0.7.1
  142.    - Fixed Bug in password support
  143.  
  144.    Version 0.7.1c
  145.    - Changes by Flurin Honegger
  146.    - Fixed 4GB limit (Filesize, Archive and Multivolume)
  147.    - Added fileseek for Int64 (some Delphi versions do not take the right internal one)
  148.  
  149.    Version 0.7.2
  150.    - added kpidLastAccessTime with value = 0
  151.    - fixed bug in addrootdir during add
  152.  
  153.    Version 0.7.3
  154.    - changed Getindexbyfilename -> InternalGetindexbyfilename by Zach Saw
  155.    - added UseLog switch for smaller exe by Guillaume Di Giusto
  156.    - Some other minor changes
  157.  
  158.    Version 0.7.4
  159.    - Bugfixes
  160.    - Changed function name
  161.  
  162.    Version 0.7.4a
  163.    - Fixed bug while adding files with AddStoreonlyfilename
  164.  
  165.   Author Shortcuts:   FHO    Flurin Honegger             fhonegger@b2i.info
  166.   Who    When          What
  167.   --------------------------------------------------------------------------
  168.   FHO    17.01.2007  - Need the filenames back when creating a multivolume
  169.                        archive.
  170.  
  171.          20.01.2007  - Handles are of type cardinal. Comparison of the type
  172.                        "if Returned_Handle <=0 then" are not correct.
  173.                        Code changed to look like
  174.                        "if Returned_Handle = INVALID_HANDLE_VALUE".
  175.  
  176.   FHO    21.01.2007  - Call to onmessage event handler references:
  177.                         a.) Fxxx constant used
  178.                         b.) Messagestrings collected in c7zipResMsg and
  179.                             referenced by Fxxx constants
  180.  
  181.   FHO    22.01.2007  - Need better reason for error (GetLastError) return!
  182.                        Corresponding code added.
  183.                      - {$IFNDEF RegisterInThisUnit} added. I prefer to
  184.                        register in a different "Collection unit".
  185.  
  186.   FHO    25.01.2007  - Resident non residient code realized with one
  187.                        switch UseRes7zdll only.
  188.                      - Comparison after LoadLibrary must be "<>0" and not
  189.                        ">0". Similar problem as the one fixed 20.01.2007.
  190.  
  191. *)
  192.  
  193. (*
  194.    Known Issues / Things ToDo:
  195.    
  196.     - No archive properties during listing
  197.     - With Solid archives filenames and progress during extract comes very late
  198.      ( at the end )
  199.     - No deleting files from archive
  200.     - No adding to existing archives
  201.     - If a wrong password is given a crash occures at position marked with
  202.                      "//FHO crash at wrong pw 25.01.2007"
  203.     - Multi volume sfx does not work.                
  204.  
  205.   Please mark all changes with your sign and date e.g. rg 01.01.06
  206.   and send it to me SevenZipVCL@rg-software.de
  207. *)
  208.  
  209.  
  210. //----------------------------------------------------------------------
  211. // Conditional switches
  212. //----------------------------------------------------------------------
  213.  
  214. // {$WARN UNIT_PLATFORM OFF}    //works with higer Delphi versions
  215. // {$WARN SYMBOL_PLATFORM OFF}  //works with higer Delphi versions
  216.  
  217.  
  218. //----------------------------------------------------------------------
  219. // Define to use Resfile with 7z.dll, no external dll, accessing through
  220. //  BTMemoryModule                                             //FHO 25.01.2007
  221. //----------------------------------------------------------------------
  222. {$DEFINE UseRes7zdll}
  223.  
  224. //----------------------------------------------------------------------
  225. //Register within this unit or in external Collection
  226. //----------------------------------------------------------------------
  227. {$DEFINE RegisterInThisUnit}
  228.  
  229. //----------------------------------------------------------------------
  230. // Dynamically load dll
  231. //----------------------------------------------------------------------
  232. //{$DEFINE DynaLoadDLL} // Not used now
  233.  
  234. // GDG 21.02.07 : added conditional switch to disable log functions and make final program smaller
  235. //----------------------------------------------------------------------
  236. // Define if you want to use log functions
  237. //----------------------------------------------------------------------
  238. //{$DEFINE UseLog}
  239.  
  240. interface
  241. {$IFDEF UseRes7zdll}
  242. //  {$R 7za.res}
  243. {$ENDIF}
  244.  
  245. uses
  246.   Windows, SysUtils, Classes, ActiveX,comobj,filectrl
  247.   {$IFDEF UseRes7zdll}
  248.   ,BTMemoryModule
  249.   {$ENDIF}
  250.   ;
  251.  
  252. Const sZipLibDLL = '7zip_library';
  253.  
  254. const
  255. //7z internal consts
  256.  
  257. //Extract
  258.   //NAskMode
  259.   kExtract = 0;
  260.   kTest    = 1;
  261.   kSkip    = 2;
  262.  
  263.   //NOperationResult
  264.   kOK                = 0;
  265.   kUnSupportedMethod = 1;
  266.   kDataError         = 2;
  267.   kCRCError          = 3;
  268.  
  269.   FNAME_MAX32 = 512;
  270.  
  271. // SevenZIP onMessage Errorcode
  272.   FNoError             = 0;
  273.   FFileNotFound        = 1;
  274.   FDataError           = 2;
  275.   FCRCError            = 3;
  276.   FUnsupportedMethod   = 4;
  277.   FIndexOutOfRange     = 5;                                    //FHO 21.01.2007
  278.   FUsercancel          = 6;
  279.   FNoSFXarchive        = 7;
  280.   FSFXModuleError      = 8;
  281.   FSXFileCreationError = 9;                                    //FHO 21.01.2007
  282.   FNoFilesToAdd        =10;                                    //FHO 21.01.2007
  283.   FNoFileCreated       =11;
  284.  
  285.   c7zipResMsg:array[FNoError..FNoFileCreated] of string=       //FHO 21.01.2007
  286.   { 0}('Success',                                              //FHO 21.01.2007
  287.   { 1} 'File not found',                                       //FHO 21.01.2007
  288.   { 2} 'Data Error',                                           //FHO 21.01.2007
  289.   { 3} 'CRC Error',                                            //FHO 21.01.2007
  290.   { 4} 'Unsupported Method',                                   //FHO 21.01.2007
  291.   { 5} 'Index out of Range',                                   //FHO 21.01.2007
  292.   { 6} 'User canceled operation',                              //FHO 21.01.2007
  293.   { 7} 'File is not an 7z SFX archive',                        //FHO 21.01.2007
  294.   { 8} 'SFXModule error ( Not found )',                        //FHO 21.01.2007
  295.   { 9} 'Could not create SFX',                                 //FHO 21.01.2007
  296.   {10} 'No files to add',                                      //FHO 21.01.2007
  297.   {11} 'Could not create file'                                 //FHO 21.01.2007
  298.  
  299.        );                                                      //FHO 21.01.2007
  300.  
  301.  
  302.  
  303. const
  304.   kpidNoProperty = 0;
  305.   kpidHandlerItemIndex = 2;
  306.   kpidPath = 3;
  307.   kpidName = 4;
  308.   kpidExtension = 5;
  309.   kpidIsFolder = 6;
  310.   kpidSize = 7;
  311.   kpidPackedSize = 8;
  312.   kpidAttributes = 9;
  313.   kpidCreationTime = 10;
  314.   kpidLastAccessTime = 11;
  315.   kpidLastWriteTime = 12;
  316.   kpidSolid = 13;
  317.   kpidCommented = 14;
  318.   kpidEncrypted = 15;
  319.   kpidSplitBefore = 16;
  320.   kpidSplitAfter = 17;
  321.   kpidDictionarySize = 18;
  322.   kpidCRC = 19;
  323.   kpidType = 20;
  324.   kpidIsAnti = 21;
  325.   kpidMethod = 22;
  326.   kpidHostOS = 23;
  327.   kpidFileSystem = 24;
  328.   kpidUser = 25;
  329.   kpidGroup = 26;
  330.   kpidBlock = 27;
  331.   kpidComment = 28;
  332.   kpidPosition = 29;
  333.  
  334.   kpidTotalSize = $1100;
  335.   kpidFreeSpace = $1101;
  336.   kpidClusterSize = $1102;
  337.   kpidVolumeName = $1103;
  338.  
  339.   kpidLocalName = $1200;
  340.   kpidProvider = $1201;
  341.   kpidUserDefined = $10000;
  342.  
  343.  
  344. //jjw 18.10.2006
  345. type
  346.   TCreateObjectFunc = function ( const clsid: PGUID; const iid: PGUID; out _out ): Integer; stdcall;
  347.  
  348.  
  349. //----------------------------------------------------------------------------------------------------
  350. //--------------Widestring Classes--------------------------------------------------------------------
  351. //----------------------------------------------------------------------------------------------------
  352.  
  353. type
  354.   TWideStringArray = array of WideString;
  355.  
  356.   TWideStringList_ = class( TObject )
  357.    private
  358.    public
  359.     WStrings: array of WideString;
  360.     Count: Longword;
  361.     constructor Create;
  362.     procedure Clear;
  363.     procedure AddString( s: WideString );
  364.     procedure RemoveString( s: WideString );
  365.    end;
  366.  
  367.  
  368. type
  369.   TCompressType = ( LZMA,PPMD );
  370.   TCompressStrength = ( SAVE,FAST,NORMAL,MAXIMUM,ULTRA );
  371.   TLZMAStrength = 0..27;
  372.   TPPMDMem = 1..31;
  373.   TPPMDSize = 2..32;
  374.  
  375.   AddOptsEnum = ( AddRecurseDirs, AddSolid, AddStoreOnlyFilename, AddIncludeDriveLetter, AddEncryptFilename );
  376.   AddOpts = Set Of AddOptsEnum;
  377.  
  378.   ExtractOptsEnum = ( ExtractNoPath,ExtractOverwrite );
  379.   ExtractOpts = Set Of ExtractOptsEnum;
  380.  
  381. //----------------------------------------------------------------------------------------------------
  382. //----------------------------------------------------------------------------------------------------
  383. //--------------Start SevenZip Interface-------------------------------------------------------
  384. //----------------------------------------------------------------------------------------------------
  385. //----------------------------------------------------------------------------------------------------
  386.  
  387.  
  388. type
  389.   TInterfacedObject = class( TObject, IUnknown )
  390.   protected
  391.     FRefCount: Integer;
  392.     function QueryInterface( const IID: TGUID; out Obj ): HResult; stdcall;
  393.     function _AddRef: Integer; stdcall;
  394.     function _Release: Integer; stdcall;
  395.   public
  396.     procedure AfterConstruction; override;
  397.     procedure BeforeDestruction; override;
  398.     class function NewInstance: TObject; override;
  399.     property RefCount: Integer read FRefCount;
  400.   end;
  401.  
  402. const
  403. //  Correct below for 7-Zip 4.23 or 4.29. Comment this line
  404. //  {$DEFINE 7z423}
  405.   {$DEFINE 7z429}
  406.  
  407.   {$IFDEF 7z423}
  408.   szCLSID_CFormat7z = '{23170F69-40C1-278A-1000-000110050000}';
  409.   szIID_IInArchive = '{23170F69-40C1-278A-0000-000100080000}';
  410.   szIID_IOutArchive = '{23170F69-40C1-278A-0000-000100020000}';
  411.   szIID_ISetProperties = '{23170F69-40C1-278A-0000-000100030000}';
  412.   szIID_IOutStream = '{23170F69-40C1-278A-0000-000000040000}';
  413.   szIID_ISequentialInStream = '{23170F69-40C1-278A-0000-000000010000}';
  414.   szIID_IInStream = '{23170F69-40C1-278A-0000-000000030000}';
  415.   szIID_IStreamGetSize = '{23170F69-40C1-278A-0000-000000060000}';
  416.   szIID_IArchiveOpenCallback = '{23170F69-40C1-278A-0000-000100010000}';
  417.   szIID_IArchiveExtractCallback = '{23170F69-40C1-278A-0000-000100090000}';
  418.   szIID_IArchiveUpdateCallback = '{23170F69-40C1-278A-0000-000100040000}';
  419.   szIID_IProgress = '{23170F69-40C1-278A-0000-000000050000}';
  420.   szIID_ISequentialOutStream = '{23170F69-40C1-278A-0000-000000020000}';
  421.   {$ENDIF}
  422.  
  423.   {$IFDEF 7z429}
  424. //000
  425.   szIID_IProgress =                         '{23170F69-40C1-278A-0000-000000050000}';
  426. //30
  427.   szIID_ISequentialInStream =               '{23170F69-40C1-278A-0000-000300010000}';
  428.   szIID_ISequentialOutStream =              '{23170F69-40C1-278A-0000-000300020000}';
  429.   szIID_IInStream =                         '{23170F69-40C1-278A-0000-000300030000}';
  430.   szIID_IOutStream =                        '{23170F69-40C1-278A-0000-000300040000}';
  431.   szIID_IStreamGetSize =                    '{23170F69-40C1-278A-0000-000300060000}';
  432.   szIID_IOutStreamFlush =                   '{23170F69-40C1-278A-0000-000300070000}';
  433. //400
  434.   szIID_ICompressProgressInfo =             '{23170F69-40C1-278A-0000-000400040000}';
  435.   szIID_ICompressCoder =                    '{23170F69-40C1-278A-0000-000400050000}';
  436.   szIID_ICompressCoder2 =                   '{23170F69-40C1-278A-0000-000400180000}';
  437.   szIID_ICompressSetCoderProperties =       '{23170F69-40C1-278A-0000-000400200000}';
  438.   szIID_ICompressSetDecoderProperties =     '{23170F69-40C1-278A-0000-000400210000}';
  439.   szIID_ICompressSetDecoderProperties2 =    '{23170F69-40C1-278A-0000-000400220000}';
  440.   szIID_ICompressWriteCoderProperties =     '{23170F69-40C1-278A-0000-000400230000}';
  441.   szIID_ICompressGetInStreamProcessedSize = '{23170F69-40C1-278A-0000-000400240000}';
  442.   szIID_ICompressGetSubStreamSize =         '{23170F69-40C1-278A-0000-000400300000}';
  443.   szIID_ICompressSetInStream =              '{23170F69-40C1-278A-0000-000400310000}';
  444.   szIID_ICompressSetOutStream =             '{23170F69-40C1-278A-0000-000400320000}';
  445.   szIID_ICompressSetInStreamSize =          '{23170F69-40C1-278A-0000-000400330000}';
  446.   szIID_ICompressSetOutStreamSize =         '{23170F69-40C1-278A-0000-000400340000}';
  447.   szIID_ICompressFilter =                   '{23170F69-40C1-278A-0000-000400400000}';
  448.   szIID_ICryptoProperties =                 '{23170F69-40C1-278A-0000-000400800000}';
  449.   szIID_ICryptoSetPassword =                '{23170F69-40C1-278A-0000-000400900000}';
  450.   szIID_ICryptoSetCRC =                     '{23170F69-40C1-278A-0000-000400A00000}';
  451. //500
  452.   szIID_ICryptoGetTextPassword =            '{23170F69-40C1-278A-0000-000500100000}';
  453.   szIID_ICryptoGetTextPassword2 =           '{23170F69-40C1-278A-0000-000500110000}';
  454. //600
  455.   szIID_ISetProperties =                    '{23170F69-40C1-278A-0000-000600030000}';
  456.   szIID_IArchiveOpenCallback =              '{23170F69-40C1-278A-0000-000600100000}';
  457.   szIID_IArchiveExtractCallback =           '{23170F69-40C1-278A-0000-000600200000}';
  458.   szIID_IArchiveOpenVolumeCallback =        '{23170F69-40C1-278A-0000-000600300000}';
  459.   szIID_IInArchiveGetStream =               '{23170F69-40C1-278A-0000-000600400000}';
  460.   szIID_IArchiveOpenSetSubArchiveName =     '{23170F69-40C1-278A-0000-000600500000}';
  461.   szIID_IInArchive =                        '{23170F69-40C1-278A-0000-000600600000}';
  462.   szIID_IArchiveUpdateCallback =            '{23170F69-40C1-278A-0000-000600800000}';
  463.   szIID_IArchiveUpdateCallback2 =           '{23170F69-40C1-278A-0000-000600820000}';
  464.   szIID_IOutArchive =                       '{23170F69-40C1-278A-0000-000600A00000}';
  465.  
  466.   szCLSID_CFormat7z =                       '{23170F69-40C1-278A-1000-000110070000}';
  467.  
  468.   szIID_CCrypto_Hash_SHA256                = '{23170F69-40C1-278B-0703-000000000000}';
  469.  
  470.   szIID_CCrypto7zAESEncoder                = '{23170F69-40C1-278B-06F1-070100000100}';
  471.   szIID_CCrypto7zAESDecoder                = '{23170F69-40C1-278B-06F1-070100000000}';
  472.   {$ENDIF}
  473.  
  474.   CLSID_CFormat7z: TGUID = szCLSID_CFormat7z;
  475.   IID_IInArchive: TGUID = szIID_IInArchive;
  476.   IID_IOutArchive: TGUID = szIID_IOutArchive;
  477.   IID_ISetProperties: TGUID = szIID_ISetProperties;
  478.   IID_ICompressCoder: TGUID = szIID_ICompressCoder;
  479.   IID_ICryptoGetTextPassword: TGUID = szIID_ICryptoGetTextPassword;
  480.   IID_ICryptoGetTextPassword2: TGUID = szIID_ICryptoGetTextPassword2;
  481.   IID_ICryptoSetPassword: TGUID = szIID_ICryptoSetPassword;
  482.   IID_IOutStream: TGUID = szIID_IOutStream;
  483.   IID_ISequentialInStream: TGUID = szIID_ISequentialInStream;
  484.   IID_IInStream: TGUID = szIID_IInStream;
  485.   IID_IStreamGetSize: TGUID = szIID_IStreamGetSize;
  486.   IID_IArchiveOpenCallback: TGUID = szIID_IArchiveOpenCallback;
  487.   IID_ICompressGetSubStreamSize: TGUID = szIID_ICompressGetSubStreamSize;
  488.   IID_IArchiveOpenSetSubArchiveName: TGUID = szIID_IArchiveOpenSetSubArchiveName;
  489.   IID_IArchiveExtractCallback: TGUID = szIID_IArchiveExtractCallback;
  490.   IID_IArchiveOpenVolumeCallback: TGUID = szIID_IArchiveOpenVolumeCallback;
  491.   IID_IArchiveUpdateCallback: TGUID = szIID_IArchiveUpdateCallback;
  492.   IID_IArchiveUpdateCallback2: TGUID = szIID_IArchiveUpdateCallback2;
  493.   IID_IProgress: TGUID = szIID_IProgress;
  494.   IID_ISequentialOutStream: TGUID = szIID_ISequentialOutStream;
  495.   IID_CCrypto7zAESEncoder: TGUID = szIID_CCrypto7zAESEncoder;
  496.  
  497.  
  498. type
  499.   HARC = THandle;
  500.   PInt64 = ^Int64;
  501.  
  502. type
  503.   ISetProperties = interface( IUnknown )
  504.     [ szIID_ISetProperties ]
  505.     function SetProperties( const names: PWideChar; const values: PPROPVARIANT; numProperties: Integer ): Integer; stdcall;
  506.   end;
  507.  
  508.   ICompressProgressInfo = interface( IUnknown )
  509.     [ szIID_ICompressProgressInfo ]
  510.     function SetRatioInfo( const inSize, outSize: Int64 ): Integer; stdcall;
  511.   end;
  512.  
  513.   ISequentialOutStream = interface( IUnknown )
  514.     [ szIID_ISequentialOutStream ]
  515.     function Write( const data; size: DWORD; processedSize: PDWORD ): Integer; stdcall;
  516.     {$IFDEF 7z423}
  517.     function WritePart( const data; size: DWORD; processedSize: PDWORD ): Integer; stdcall;
  518.     {$ENDIF}
  519.   end;
  520.  
  521.   ISequentialInStream = interface( IUnknown )
  522.     [ szIID_ISequentialInStream ]
  523.     function Read( var data; size: DWORD; processedSize: PDWORD ): Integer; stdcall;
  524.     {$IFDEF 7z423}
  525.     function ReadPart( var data; size: DWORD; processedSize: PDWORD ): Integer; stdcall;
  526.     {$ENDIF}
  527.   end;
  528.  
  529.   ICryptoGetTextPassword = interface( IUnknown )
  530.     [ szIID_ICryptoGetTextPassword ]
  531.     function CryptoGetTextPassword( var Password: PWideChar ): Integer; stdcall;
  532.   end;
  533.  
  534.   ICryptoGetTextPassword2 = interface( IUnknown )
  535.     [ szIID_ICryptoGetTextPassword2 ]
  536.     function CryptoGetTextPassword2( passwordIsDefined: PInteger; var Password: PWideChar ): Integer; stdcall;
  537.   end;
  538.  
  539.   ICryptoProperties = interface( IUnknown )
  540.     [ szIID_ICryptoProperties ]
  541.     function SetKey( const Data; Size: DWORD ): Integer; stdcall;
  542.     function SetInitVector( const Data; Size: DWORD ): Integer; stdcall;
  543.   end;
  544.  
  545.   ICompressCoder = interface( IUnknown )
  546.     [ szIID_ICompressCoder ]
  547.     function Code( inStream: ISequentialInStream; outStream: ISequentialOutStream;
  548.       const inSize, outSize: Int64; Progress: ICompressProgressInfo ): Integer; stdcall;
  549.   end;
  550.  
  551.   ICryptoSetPassword = interface( IUnknown )
  552.     [ szIID_ICryptoSetPassword ]
  553.     function CryptoSetPassword( const Data; Size: DWORD ): Integer; stdcall;
  554.   end;
  555.  
  556.   ICryptoSetCRC = interface( IUnknown )
  557.     [ szIID_ICryptoSetCRC ]
  558.     function CryptoSetCRC( CRC: DWORD ): Integer; stdcall;
  559.   end;
  560.  
  561.   IInStream = interface( ISequentialInStream )
  562.     [ szIID_IInStream ]
  563.     function Seek( offset: Int64; seekOrigin: DWORD;newPosition: PInt64 ): Integer; stdcall;
  564.   end;
  565.  
  566.   IStreamGetSize = interface( IUnknown )
  567.     [ szIID_IStreamGetSize ]
  568.     function GetSize( var size: Int64 ): Integer; stdcall;
  569.   end;
  570.  
  571.   IArchiveOpenCallback = interface( IUnknown )
  572.     [ szIID_IArchiveOpenCallback ]
  573.     function SetTotal( const files: Int64; const bytes: Int64 ): Integer; stdcall;
  574.     function SetCompleted( const files: Int64; const bytes: Int64 ): Integer; stdcall;
  575.   end;
  576.  
  577.   IArchiveOpenVolumeCallback = interface( IUnknown )
  578.     [ szIID_IArchiveOpenVolumeCallback ]
  579.     function GetProperty( propID: PROPID; var value: PROPVARIANT ): Integer; stdcall;
  580.     function GetStream( const name:Widechar; var inStream: IInStream ): Integer; stdcall;
  581.   end;
  582.  
  583.   IArchiveOpenSetSubArchiveName = interface( IUnknown )
  584.     [ szIID_IArchiveOpenSetSubArchiveName ]
  585.     function SetSubArchiveName( const Name: PWideString ): Integer; stdcall;
  586.   end;
  587.  
  588.   IProgress = interface( IUnknown )
  589.     [ szIID_IProgress ]
  590.     function SetTotal( total: Int64 ): Integer; stdcall;
  591.     function SetCompleted( const completeValue: PInt64 ): Integer; stdcall;
  592.   end;
  593.  
  594.   IArchiveExtractCallback = interface( IProgress )
  595.     [ szIID_IArchiveExtractCallback ]
  596.     function GetStream( index: DWORD; out outStream: ISequentialOutStream;  askExtractMode: DWORD ): Integer; stdcall;
  597.     // GetStream OUT: S_OK - OK, S_FALSE - skeep this file
  598.     function PrepareOperation( askExtractMode: Integer ): Integer; stdcall;
  599.     function SetOperationResult( resultEOperationResult: Integer ): Integer; stdcall;
  600.   end;
  601.  
  602.   IInArchive = interface( IUnknown )
  603.     [ szIID_IInArchive ]
  604.     function Open( stream: IInStream; const maxCheckStartPosition: PInt64; openArchiveCallback: IArchiveOpenCallback ): Integer; stdcall;
  605.     function Close( ): Integer; stdcall;
  606.     function GetNumberOfItems( out numItems: DWORD ): Integer; stdcall;
  607.     function GetProperty( index: DWORD; propID: PROPID; var value: PROPVARIANT ): Integer; stdcall;
  608.     function Extract( const indices: PDWORD; numItems: DWORD;   testMode: Integer; extractCallback: IArchiveExtractCallback ): Integer; stdcall;
  609.     function GetArchiveProperty( propID: PROPID; value: PPROPVARIANT ): Integer; stdcall;
  610.     function GetNumberOfProperties( var numProperties: DWORD ): Integer; stdcall;
  611.     function GetPropertyInfo( index: DWORD; var name: TBSTR; var propID: PROPID; var varType: {PVARTYPE}Integer ): Integer; stdcall;
  612.     function GetNumberOfArchiveProperties( var numProperties ): Integer; stdcall;
  613.     function GetArchivePropertyInfo( index: DWORD; name: PBSTR; propID: PPROPID; varType: {PVARTYPE}PInteger ): Integer; stdcall;
  614.   end;
  615.  
  616.   IArchiveUpdateCallback = interface( IProgress )
  617.     [ szIID_IArchiveUpdateCallback ]
  618.     //function EnumProperties( var enumerator: IEnumSTATPROPSTG ): Integer; stdcall;
  619.     function GetUpdateItemInfo( index: DWORD;
  620.       newData: PInteger; // 1 - new data, 0 - old data
  621.       newProperties: PInteger; // 1 - new properties, 0 - old properties
  622.       indexInArchive: PDWORD // -1 if there is no in archive, or if doesn't matter
  623.       ): Integer; stdcall;
  624.     function GetProperty( index: DWORD; propID: PROPID; value: PPROPVARIANT ): Integer; stdcall;
  625.     function GetStream( index: DWORD; var inStream: ISequentialInStream ): Integer; stdcall;
  626.     function SetOperationResult( operationResult: Integer ): Integer; stdcall;
  627.   end;
  628.  
  629.  
  630.   IArchiveUpdateCallback2 = interface( IProgress )
  631.     [ szIID_IArchiveUpdateCallback2 ]
  632.     //function EnumProperties( var enumerator: IEnumSTATPROPSTG ): Integer; stdcall;
  633.     function GetVolumeSize( index: DWORD; Size:DWord ): Integer; stdcall;
  634.     function GetVolumeStream( index: DWORD; var volumeStream: ISequentialInStream ): Integer; stdcall;
  635.   end;
  636.  
  637.   IOutArchive = interface( IUnknown )
  638.     [ szIID_IOutArchive ]
  639.     function UpdateItems( outStream: ISequentialOutStream; numItems: DWORD; updateCallback: IArchiveUpdateCallback ): Integer; stdcall;
  640.     function GetFileTimeType( var _type: DWORD ): Integer; stdcall;
  641.   end;
  642.  
  643.   IOutStream = interface( ISequentialOutStream )
  644.     [ szIID_IOutStream ]
  645.     function Seek( offset: Int64; seekOrigin: DWORD; newPosition: PInt64 ): Integer; stdcall;
  646.     function SetSize( newSize: Int64 ): Integer; stdcall;
  647.   end;
  648.  
  649. // -----------------------------------------------------------------------------
  650.  
  651.   TSevenZip = class;   // for reference only, implementated later below
  652.   TOpenVolume = procedure( var arcFileName: WideString; Removable: Boolean; out Cancel: Boolean ) of object;
  653.  
  654.   TFiles = record
  655.     Name: WideString;
  656.     Handle: cardinal; //Integer;                              //FHO  20.01.2007
  657.     Size: Int64;//DWORD;                                      // RG  26.01.2007
  658.     OnRemovableDrive: Boolean;
  659.   end;
  660.  
  661.   TArrayOfFiles = array of TFiles;                             //FHO 17.01.2007
  662.  
  663.   TMyStreamWriter = class( TInterfacedObject, ISequentialOutStream, IOutStream )
  664.   private
  665.     arcName: WideString;
  666.     arcDate: Tdatetime;
  667.     arcAttr: DWORD;
  668.     arcCreateSFX: Boolean;
  669.     arcVolumeSize: DWORD;
  670.     arcPosition, arcSize: int64; // DWORD;                     // RG  26.01.2007
  671.     FPLastError:PInteger;                                      //FHO 22.01.2007
  672.     MyLastError: Integer;                                      //FHO 22.01.2007
  673.     Files: TArrayOfFiles;
  674.  
  675.     function CreateNewFile: Boolean;
  676.   protected
  677.     property TheFiles: TArrayOfFiles read Files;
  678.   public
  679.     destructor Destroy; override;
  680.     constructor Create( PLastError:PInteger;sz: Widestring;    //FHO 22.01.2007
  681.                         szDate: Tdatetime; FAttr: Cardinal;
  682.                         VolumeSize: Integer = 0; CreateSFX: Boolean = FALSE );
  683.     function Write( const Data; Size: DWORD; ProcessedSize: PDWORD ): Integer; stdcall;
  684.     function WritePart( const Data; Size: DWORD; ProcessedSize: PDWORD ): Integer; stdcall;
  685.     function Seek( Offset: Int64; SeekOrigin: DWORD; NewPosition: PInt64 ): Integer; stdcall;
  686.     function SetSize( newSize: Int64 ): Integer; stdcall;
  687.   end;
  688.  
  689.   TMyStreamReader = class( TInterfacedObject, IInStream, IStreamGetSize, ISequentialInStream )
  690.     FSevenZip: TSevenZip;
  691.     arcName: WideString;
  692.     arcPosition, arcSize: Int64; //DWORD;                     // RG  26.01.2007
  693.     Files: TArrayOfFiles;
  694.     FOnOpenVolume: TOpenVolume;
  695.     FArchive: Boolean;
  696.     MyLastError: Integer;                                      //FHO 22.01.2007
  697.    
  698.     FMultivolume: Boolean;
  699.     function BrowseForFile( Title: PWideChar; var Name: WideString ): Boolean;
  700.     function OpenVolume( Index: Integer ): Boolean;
  701.     function OpenNextVolume: Boolean;
  702.     function OpenLastVolume: Boolean;
  703.   public
  704.     constructor Create( Owner: TSevenZip; sz: Widestring; asArchive: Boolean );
  705.     destructor Destroy; override;
  706.     function Seek( Offset: Int64; SeekOrigin: DWORD; NewPosition: PInt64 ): Integer; stdcall;
  707.     function Read( var Data; Size: DWORD; ProcessedSize: PDWORD ): Integer; stdcall;
  708.     function ReadPart( var Data; Size: DWORD; ProcessedSize: PDWORD ): Integer; stdcall;
  709.     function GetSize( var Size: Int64 ): Integer; stdcall;
  710.   end;
  711.  
  712. // -----------------------------------------------------------------------------
  713.   TMyArchiveUpdateCallback = class( TInterfacedObject, IArchiveUpdateCallback, ICryptoGetTextPassword2, IProgress )
  714.     FSevenZip: TSevenZip;
  715.     Files: TWideStringArray;//TStringList;
  716.     Files_size: array of int64;
  717.     Files_Date: array of TFiletime;
  718.     Files_Attr: array of Cardinal;
  719.     FProgressFile: Widestring;
  720.     FProgressFilePos: int64;
  721.     FprogressFileSize: int64;
  722.     FLastPos: int64;
  723.     RootDir: WideString;
  724.     FPassword: WideString;
  725. //    FIncludeDriveletter: Boolean;
  726.     constructor Create( Owner: TSevenZip );
  727. //    destructor destroy;
  728. //    function EnumProperties( var enumerator: IEnumSTATPROPSTG ): Integer; stdcall;
  729.     function GetUpdateItemInfo(
  730.       index: DWORD;
  731.       newData: PInteger; // 1 - new data, 0 - old data
  732.       newProperties: PInteger; // 1 - new properties, 0 - old properties
  733.       indexInArchive: PDWORD // -1 if there is no in archive, or if doesn't matter
  734.     ): Integer; stdcall;
  735.     function GetProperty( index: DWORD; propID: PROPID; value: PPROPVARIANT ): Integer; stdcall;
  736.     function GetStream( index: DWORD; var inStream: ISequentialInStream ): Integer; stdcall;
  737.     function SetOperationResult( operationResult: Integer ): Integer; stdcall;
  738. // Shadow 29.11.2006
  739.     function CryptoGetTextPassword2( passwordIsDefined: PInteger; var Password: PWideChar ): Integer; stdcall;
  740.     function SetTotal( total: Int64 ): Integer; stdcall;
  741.     function SetCompleted( const completeValue: PInt64 ): Integer; stdcall;
  742.   end;
  743.  
  744.   TMyArchiveExtractCallback = class( TInterfacedObject, IArchiveExtractCallback, ICryptoGetTextPassword )
  745.     FSevenzip: TSevenzip;
  746.     FExtractDirectory: Widestring;
  747.     FProgressFile: Widestring;
  748.     FProgressFilePos: int64;
  749.     FProgressFileSize: int64;
  750.     FLastPos: int64;
  751.     FFilestoextract: int64;
  752.     FLastFileToExt: Boolean;
  753.     FAllFilesExt: Boolean;
  754.     FPassword: WideString;
  755.     constructor Create( Owner: TSevenZip );
  756.     function GetStream( index: DWORD; out outStream: ISequentialOutStream; askExtractMode: DWORD ): Integer; stdcall;
  757.     // GetStream OUT: S_OK - OK, S_FALSE - skeep this file
  758.     function PrepareOperation( askExtractMode: Integer ): Integer; stdcall;
  759.     function SetOperationResult( resultEOperationResult: Integer ): Integer; stdcall;
  760.     function SetTotal( total: Int64 ): Integer; stdcall;
  761.     function SetCompleted( const completeValue: PInt64 ): Integer; stdcall;
  762. // Shadow 29.11.2006
  763.     function CryptoGetTextPassword( var Password: PWideChar ): Integer; stdcall;
  764.   end;
  765.  
  766.  
  767.   TMyArchiveOpenCallback = class( TInterfacedObject, IArchiveOpenCallback, ICryptoGetTextPassword )
  768.     FSevenzip: TSevenzip;
  769.     FPassword: WideString;
  770.     constructor Create( Owner: TSevenZip );
  771.     function SetTotal( const files: Int64; const bytes: Int64 ): Integer; stdcall;
  772.     function SetCompleted( const files: Int64; const bytes: Int64 ): Integer; stdcall;
  773.     function CryptoGetTextPassword( var Password: PWideChar ): Integer; stdcall;
  774.   end;
  775.  
  776. //----------------------------------------------------------------------------------------------------
  777. //----------------------------------------------------------------------------------------------------
  778. //--------------END SevenZip Interface--------------------------------------------------------
  779. //----------------------------------------------------------------------------------------------------
  780. //----------------------------------------------------------------------------------------------------
  781.  
  782.  
  783.  
  784.  
  785. //----------------------------------------------------------------------------------------------------
  786. //----------------------------------------------------------------------------------------------------
  787. //--------------Start SevenZip VCL -------------------------------------------------------------
  788. //----------------------------------------------------------------------------------------------------
  789. //----------------------------------------------------------------------------------------------------
  790.  
  791. //type
  792.   T7zListfileEvent    = procedure( Sender: TObject; Filename: Widestring; Fileindex,FileSizeU,FileSizeP,Fileattr,Filecrc:int64;Filemethod:Widestring ;FileTime:double ) of object;
  793.   T7zExtractfileEvent = procedure( Sender: TObject; Filename: Widestring; Filesize:int64 ) of object;
  794.   T7zAddFileEvent     = procedure( Sender: TObject; Filename: Widestring; Filesize:int64 ) of object;
  795.   T7zPreProgressEvent = procedure( Sender: TObject; MaxProgress: int64 ) of object;
  796.   T7zProgressEvent    = procedure( Sender: TObject; Filename: Widestring; FilePosArc,FilePosFile: int64 ) of object;
  797.   T7zMessageEvent     = procedure( Sender: TObject; ErrCode: Integer; Message: string;Filename:Widestring )  of object;
  798. //  T7zCRC32ErrorEvent = procedure( Sender: TObject; ForFile: string;  FoundCRC, ExpectedCRC: LongWord; var DoExtract: Boolean ) of object;
  799. //  TC7zommentEvent = procedure( Sender: TObject;Comment: string; ) of object;
  800.  
  801. // GDG 21.02.07 : added FileIndex to this event in case we're managing a list of files.
  802.   T7zSetNewNameEvent = procedure( Sender: TObject; FileIndex: DWORD; var OldFileName: WideString ) of object;
  803.  
  804.   T7zExtractOverwrite = procedure( Sender: TObject; FileName: WideString; var DoOverwrite: Boolean ) of object;
  805.  
  806. //type
  807.   TSevenZip = class( TComponent )       // Twincontrol   TComponent
  808.   private
  809.     FErrCode: Integer;
  810.     FLastError:Integer;                                        //FHO 22.01.2007
  811.     FHandle: HWND;
  812. //    FMessage: Widestring; // Not used now ErikGG 08.11.06
  813.     FExtrBaseDir: Widestring;
  814.     FSevenZipFileName: Widestring;
  815.  
  816.     FComment: Widestring;
  817.     FRootDir: Widestring;
  818.  
  819.     Ffiles: TWideStringList_;
  820.  
  821.     { Event variables }
  822.     FOnProgress: T7zProgressEvent;
  823.     FOnPreProgress: T7zPreProgressEvent;
  824.     FOnMessage: T7zMessageEvent;
  825.     FOnlistfile: T7zlistfileEvent;
  826.     FOnextractfile: T7zextractfileEvent;
  827.     FOnaddfile: T7zaddfileEvent;
  828.     FOnSetAddName: T7zSetNewNameEvent;
  829.     FOnSetExtractName: T7zSetNewNameEvent;
  830.     FOnExtractOverwite: T7zExtractOverwrite;
  831.  
  832.     FAddOptions: Addopts;
  833.     FExtractOptions: Extractopts;
  834.     FNumberOfFiles: Integer;
  835.     FIsSFX: Boolean;
  836.     FSFXOffset: Int64;
  837.     FSFXCreate: Boolean;
  838.     FSFXModule: Widestring;
  839.     FCompresstype: TCompresstype;
  840.     FCompstrength: TCompressStrength;
  841.     FLZMAStrength: TLZMAStrength;
  842.     FPPMDSize: TPPMDSize;
  843.     FPPMDMem: TPPMDMem;
  844.     FMainCancel: Boolean;
  845.  
  846. // Shadow 28.11.2006
  847. {$IFDEF UseRes7zdll}
  848.     mp_MemoryModule: PBTMemoryModule;
  849.     mp_DllData: Pointer;
  850.     m_DllDataSize: Integer;
  851. {$ELSE}                                                        //FHO 25.01.2007
  852.     F7zaLibh: THandle;
  853. {$ENDIF}
  854.  
  855. //{$IFDEF DynaLoadDLL}
  856.     FCreateObject: TCreateObjectFunc;
  857. //{$ENDIF}
  858.  
  859.     FVolumeSize: Integer;
  860.     FOnOpenVolume: TOpenVolume;
  861.     FPassword: WideString;
  862.     FNamesOfVolumesWritten: TWideStringArray;                  //FHO 17.01.2007
  863.  
  864.     { Private "helper" functions }
  865.  
  866. //    procedure LogMessage( var msg: TMessage ); message 9999;
  867.     procedure ResetCancel;
  868.     function AppendSlash( sDir: widestring ): widestring;
  869.     procedure SetVolumeSize( const Value: Integer );
  870.     procedure SetSFXCreate( const Value: Boolean );
  871.     function InternalGetIndexByFilename( FileToExtract:Widestring ): Integer;       //ZSA 21.02.2007
  872.     procedure ClearNamesOfVolumeWritten;
  873.     procedure SetLastError(const Value: Integer);                       //FHO 17.01.2007
  874.   protected
  875.     inA: IInArchive;
  876.     outA: IOutArchive;
  877.     sp: ISetProperties;
  878.   public
  879.     constructor Create( AOwner: TComponent ); override;
  880.     destructor Destroy; override;
  881.  
  882.     { Public Properties ( run-time only ) }
  883.     property Handle: HWND read fHandle write fHandle;
  884.     property ErrCode: Integer read fErrCode write fErrCode;
  885.     property LastError:Integer read FLastError write SetLastError;// FLastError;//FHO 22.01.2007
  886.     property IsSFX: Boolean read FIsSFX write FIsSFX;
  887.     property SFXOffset: int64 read FSFXOffset write FSFXOffset;
  888.  
  889.     property SevenZipComment: Widestring read Fcomment write FComment;
  890.     property Files: TWideStringList_ read Ffiles write ffiles;
  891.     property NamesOfVolumesWritten: TWideStringArray read FNamesOfVolumesWritten;  //FHO 17.01.2007
  892.  
  893.     { Public Methods }
  894.     function Add: Integer;
  895.     function Extract( TestArchive:Boolean=False ): Integer;
  896.     function List: Integer;
  897.     procedure Cancel;
  898.     function GetIndexByFilename( FileToExtract:Widestring ): Integer;
  899.     function SFXCheck( Fn:Widestring ): Boolean;
  900.     function ConvertSFXto7z( Fn:Widestring ): boolean;
  901.     function Convert7ztoSFX( Fn:Widestring ): boolean;
  902.   published
  903.     { Public properties that also show on Object Inspector }
  904.     property AddRootDir: Widestring read FRootDir write FRootDir;
  905.     property SFXCreate: Boolean read FSFXCreate write SetSFXCreate;
  906.     property SFXModule: Widestring read FSFXModule write FSFXModule;
  907.     property AddOptions: AddOpts read FAddOptions write FAddOptions;
  908.     property ExtractOptions: ExtractOpts read FExtractOptions write FExtractOptions;
  909.     property ExtrBaseDir: Widestring read FExtrBaseDir write FExtrBaseDir;
  910.     property LZMACompressType: TCompresstype read FCompresstype write FCompresstype;
  911.     property LZMACompressStrength: TCompressStrength read FCompstrength write FCompstrength;
  912.     property LZMAStrength: TLZMAStrength read FLZMAStrength write FLZMAstrength;
  913.     property LPPMDmem: TPPMDmem read FPPMDmem write FPPMDmem;
  914.     property LPPMDsize: TPPMDsize read FPPMDsize write FPPMDsize;
  915.     property SZFileName: Widestring read FSevenZipFileName write FSevenZipFilename;
  916.     property NumberOfFiles: Integer read FNumberOfFiles write FNumberOfFiles;
  917. // Shadow 29.11.2006
  918.     property VolumeSize: Integer read FVolumeSize write SetVolumeSize;
  919.     property Password: WideString read FPassword write FPassword;
  920.     { Events }
  921.  
  922.     property OnListfile: T7zlistfileEvent read FOnlistfile write FOnlistfile;
  923.     property OnAddfile: T7zaddfileEvent read FOnaddfile write FOnaddfile;
  924.     property OnExtractfile: T7zextractfileEvent read FOnextractfile write FOnextractfile;
  925.     property OnProgress: T7zProgressEvent read FOnProgress  write FOnProgress;
  926.     property OnPreProgress: T7zPreProgressEvent read FOnPreProgress  write FOnPreProgress;
  927.     property OnMessage: T7zMessageEvent read fOnMessage write fOnMessage;
  928.     property OnSetAddName: T7zSetNewNameEvent read FOnSetAddName write FOnSetAddName;
  929.     property OnSetExtractName: T7zSetNewNameEvent read FOnSetExtractName write FOnSetExtractName;
  930.     property OnExtractOverwrite: T7zExtractOverwrite read FOnExtractOverwite write FOnExtractOverwite;
  931.     property OnOpenVolume: TOpenVolume read FOnOpenVolume write FOnOpenVolume;
  932.   end;
  933.  
  934.  
  935. // jjw 18.10.2006 FCreateobject - function CreateObject( const clsid: PGUID; const iid: PGUID; out _out ): Integer; stdcall; external '7za.dll';
  936. //{$IFNDEF DynaLoadDLL}
  937. //function CreateObject( const clsid: PGUID; const iid: PGUID; out _out ): Integer; stdcall; external '7za.dll'
  938. //{$ENDIF}
  939.  
  940. {$IFDEF UseLog}
  941. function PropTypeToString( propType: Integer ): string;
  942. function PropIDToString( propID: Integer ): string;
  943. procedure Log( sz: string );
  944. {$ENDIF}
  945. function FileTimeToDateTime( const rFileTime: TFileTime; const Localize: Integer = 0 ): TDateTime;
  946. procedure SortDWord( var A: array of DWord; iLo, iHi: DWord );
  947. function DriveIsRemovable( Drive: WideString ): Boolean;
  948. function TryStrToInt_( const S: string; out Value: Integer ): Boolean;
  949.  
  950. //Unicode procedures
  951. function UppercaseW_( s:WideString ):Widestring;
  952. function GetFileSizeandDateTime_Int64( fn: Widestring; var fs:int64; var ft:Tfiletime; var fa:Integer ): int64;
  953. function FileExists_( fn: Widestring ): Boolean;
  954. function createfile_(lpFileName:Pwidechar; Access:Cardinal; Share:Cardinal;SecAttr:PSecurityattributes;
  955.                      CreationDisposition:Cardinal;Flags:Cardinal;Temp:Cardinal) : integer;
  956.  
  957. {$IFDEF RegisterInThisUnit}
  958. procedure Register;
  959. {$ENDIF}
  960.  
  961. var FMainhandle: HWND; //for debug messages
  962. var isUnicode : Boolean;
  963.  
  964. implementation
  965.  
  966. uses
  967.   Forms, CommDlg;
  968.  
  969. //--------------------------------------------------------------------------------------------------
  970. //-------------------Start UniCode procedures-------------------------------------------------------
  971. //--------------------------------------------------------------------------------------------------
  972.  
  973. function isEqualW( s1, s2: WideString ): Boolean;
  974. var
  975.   i: Integer;
  976. begin
  977.   Result := FALSE;
  978.   if Length( s1 ) <> Length( s2 ) then Exit;
  979.   for i := 1 to Length( s1 ) do if WideChar( s1[ i ] ) <> WideChar( s2[ i ] ) then Exit;
  980.   Result := TRUE;
  981. end;
  982.  
  983. function FileExists_( fn: Widestring ): Boolean;
  984. var
  985.  fs:int64;
  986.  ft:Tfiletime;
  987.  fa:Integer;
  988. begin
  989.  if isUnicode then
  990.    Result := ( GetFileSizeandDateTime_Int64( fn,fs,ft,fa ) > -1 )
  991.   else
  992.    Result := fileexists(string(fn));
  993. end;
  994.  
  995. function PrevDir( Path: WideString ): WideString;
  996. var
  997.   l: Integer;
  998. begin
  999.   l := Length( Path );
  1000.   if ( l > 0 ) and ( Path[ l ] = '\' ) then Dec( l );
  1001.   while Path[ l ] <> '\' do Dec( l );
  1002.   Result := Copy( Path, 1, l );
  1003. end;
  1004.  
  1005. function ClearSlash( Path: WideString ): WideString;
  1006. var
  1007.   l: Integer;
  1008. begin
  1009.   l := Length( Path );
  1010.   if Path[ l ] = '\' then Dec( l );
  1011.   Result := Copy( Path, 1, l );
  1012. end;
  1013.  
  1014. function DirectoryExistsW( const Directory: WideString ): Boolean;
  1015. var
  1016.   Code: Integer;
  1017. begin
  1018.   Code := GetFileAttributesW( PWideChar( Directory ) );
  1019.   Result := ( Code <> -1 ) and ( FILE_ATTRIBUTE_DIRECTORY and Code <> 0 );
  1020. end;
  1021.  
  1022. //START function from TNTControls http://www.tntware.com/
  1023. function StrScanWide( const Str: PWideChar; Chr: WideChar ): PWideChar;
  1024. begin
  1025.   Result := Str;
  1026.   while Result^ <> Chr do
  1027.   begin
  1028.     if Result^ = #0 then
  1029.     begin
  1030.       Result := nil;
  1031.       Exit;
  1032.     end;
  1033.     Inc( Result );
  1034.   end;
  1035. end;
  1036.  
  1037. function LastDelimiterW( const Delimiters, S: WideString ): Integer;
  1038. var
  1039.   P: PWideChar;
  1040. begin
  1041.   Result := Length( S );
  1042.   P := PWideChar( Delimiters );
  1043.   while Result > 0 do
  1044.   begin
  1045.     if ( S[ Result ] <> #0 ) and ( StrScanWide( P, S[ Result ] ) <> nil ) then
  1046.       Exit;
  1047.     Dec( Result );
  1048.   end;
  1049. end;
  1050.  
  1051. function ChangeFileExtW( const FileName, Extension: WideString ): WideString;
  1052. var
  1053.   I: Integer;
  1054. begin
  1055.   I := LastDelimiterW( '.\:',Filename );
  1056.   if ( I = 0 ) or ( FileName[ I ] <> '.' ) then I := MaxInt;
  1057.   Result := Copy( FileName, 1, I - 1 ) + Extension;
  1058. end;
  1059.  
  1060. function ExtractFilePathW( const FileName: WideString ): WideString;
  1061. var
  1062.   I: Integer;
  1063. begin
  1064.   I := LastDelimiterW( '\:', FileName );
  1065.   Result := Copy( FileName, 1, I );
  1066. end;
  1067.  
  1068. function ExtractFileNameW(const FileName: WideString ): WideString;
  1069. var
  1070.   I: Integer;
  1071. begin
  1072.  I := LastDelimiterW( '\:', FileName );
  1073.  Result := Copy( FileName, I + 1, MaxInt );
  1074. end;
  1075.  
  1076. procedure GetfilenameW(var FileName: WideString );
  1077. var
  1078.   I: Integer;
  1079. begin
  1080.   if Filename <> '' then
  1081.    begin
  1082.      i := length(filename);
  1083.      while (filename[i] <> '\') and (i > 0) do dec(i);
  1084.      if i > 0 then Filename := copy( FileName, I + 1, MaxInt )
  1085.    end;
  1086. end;
  1087.  
  1088. function ExtractFileExtW( const FileName: WideString ): WideString;
  1089. var
  1090.   I: Integer;
  1091. begin
  1092.   I := LastDelimiterW( '.\:', FileName );
  1093.   if ( I > 0 ) and ( FileName[ I ] = '.' ) then
  1094.     Result := Copy( FileName, I, MaxInt ) else
  1095.     Result := '';
  1096. end;
  1097. //END function from TNTControls http://www.tntware.com/
  1098.  
  1099. function GetFileSizeandDateTime_Int64( fn: Widestring; var fs:int64; var ft:Tfiletime; var fa:Integer ): int64;
  1100. var
  1101.   FindDataW: _Win32_Find_Dataw;
  1102.   FindDataA: _Win32_Find_DataA;
  1103.   SearchHandle: THandle;
  1104. begin
  1105.   //Result := 0;
  1106.  
  1107.   if isUnicode then
  1108.    SearchHandle := FindFirstFilew( PWideChar( fn ), FindDataW )
  1109.   else
  1110.     SearchHandle := FindFirstFileA( PAnsiChar( Ansistring( fn ) ), FindDataA );
  1111.  
  1112.   if SearchHandle = INVALID_HANDLE_VALUE then
  1113.    begin
  1114.     Result := -1;
  1115.     fs := -1;
  1116.     fa := -1;
  1117.     ft.dwLowDateTime := 0;
  1118.     ft.dwHighDateTime := 0;
  1119.     exit;
  1120.    end;
  1121.  
  1122.   if isUnicode then
  1123.    begin
  1124.      LARGE_Integer( Result ).LowPart := FindDataW.nFileSizeLow;
  1125.      LARGE_Integer( Result ).HighPart := FindDataW.nFileSizeHigh;
  1126.  
  1127.      LARGE_Integer( fs ).LowPart := FindDataW.nFileSizeLow;
  1128.      LARGE_Integer( fs ).HighPart := FindDataW.nFileSizeHigh;
  1129.  
  1130.      ft.dwLowDateTime  := FinddataW.ftLastWriteTime.dwLowDateTime;
  1131.      ft.dwHighDateTime := FinddataW.ftLastWriteTime.dwHighDateTime;
  1132.      fa := FinddataW.dwFileAttributes;
  1133.    end
  1134.   else
  1135.    begin
  1136.      LARGE_Integer( Result ).LowPart := FindDataA.nFileSizeLow;
  1137.      LARGE_Integer( Result ).HighPart := FindDataA.nFileSizeHigh;
  1138.  
  1139.      LARGE_Integer( fs ).LowPart := FindDataA.nFileSizeLow;
  1140.      LARGE_Integer( fs ).HighPart := FindDataA.nFileSizeHigh;
  1141.  
  1142.      ft.dwLowDateTime  := FinddataA.ftLastWriteTime.dwLowDateTime;
  1143.      ft.dwHighDateTime := FinddataA.ftLastWriteTime.dwHighDateTime;
  1144.      fa := FinddataA.dwFileAttributes;
  1145.    end;
  1146.  
  1147.   Windows.FindClose( SearchHandle );
  1148. end;
  1149.  
  1150. function ForceDirectoriesW( Path: WideString; Attr: Word ): Boolean;
  1151. var
  1152.   E: EInOutError;
  1153. begin
  1154.   Result := TRUE;
  1155.  
  1156.   if Path = '' then begin
  1157.     E := EInOutError.Create( 'Unable to create directory' );
  1158.     E.ErrorCode := 3;
  1159.     raise E;
  1160.   end;
  1161.  
  1162.   Path := ClearSlash( Path );
  1163.   if DirectoryExistsW( Path ) then Exit;
  1164.  
  1165.   if ( Length( Path ) < 3 ) or DirectoryExistsw( Path )
  1166.     or ( ExtractFilePath( Path ) = Path ) then Exit; // avoid 'xyz:\' problem.
  1167.  
  1168.   Result := ForceDirectoriesW( PrevDir( Path ), 0 ) and CreateDirectoryW( PWideChar( Path ), nil );
  1169.   if Result and ( Attr > 0 ) then SetFileAttributesW( PWideChar( Path ), Attr );
  1170. end;
  1171.  
  1172. function UppercaseW_( s:WideString ):Widestring;
  1173. begin
  1174.   Result := S;
  1175.   if Length( Result ) > 0 then
  1176.     CharUpperBuffW( PWideChar( Result ), Length( Result ) );
  1177. end;
  1178.  
  1179. //--------------------------------------------------------------------------------------------------
  1180. //-------------------End UniCode procedures---------------------------------------------------------
  1181. //--------------------------------------------------------------------------------------------------
  1182.  
  1183. //--------------------------------------------------------------------------------------------------
  1184. //-------------------Start Twidestringlist_-----------------------------------------------------------
  1185. //--------------------------------------------------------------------------------------------------
  1186.  
  1187. procedure TWideStringList_.AddString( s: WideString );
  1188. var i:Longword;
  1189. begin
  1190.  i := length( WStrings );
  1191.  Setlength( WStrings,i+1 );
  1192.  WStrings[ i ] := s;
  1193.  Count := i+1;
  1194. end;
  1195.  
  1196. procedure TWideStringList_.RemoveString( s: WideString );
  1197. var
  1198.   i: LongWord;
  1199.   f: Boolean;
  1200. begin
  1201.   f := FALSE;
  1202.   s := UpperCase( s );
  1203.   for i := Low( WStrings ) to High( WStrings ) do begin
  1204.     if isEqualW( UppercaseW_( WStrings[ i ] ), s ) then begin
  1205.       f := TRUE;
  1206.       Break;
  1207.     end;
  1208.   end;
  1209.   if f then begin
  1210.     WStrings[ i ] := WStrings[ High( WStrings ) ];
  1211.     WStrings[ High( WStrings ) ] := '';
  1212.     SetLength( WStrings, Length( WStrings ) - 1 );
  1213.     Dec( Count );
  1214.   end;
  1215. end;
  1216.  
  1217.  
  1218. Procedure TWideStringList_.Clear;
  1219. begin
  1220.  Setlength( WStrings,0 );
  1221.  Count := 0;
  1222. end;
  1223.  
  1224. Constructor TWideStringList_.Create;
  1225. begin
  1226.  clear;
  1227. end;
  1228.  
  1229. //--------------------------------------------------------------------------------------------------
  1230. //-------------------END Twidestringlist_-------------------------------------------------------------
  1231. //--------------------------------------------------------------------------------------------------
  1232.  
  1233. //--------------------------------------------------------------------------------------------------
  1234. //  Start common functions
  1235. //------------------------------------------------------------------------------------------------
  1236.  
  1237. function createfile_(lpFileName:Pwidechar; Access:Cardinal; Share:Cardinal;SecAttr:PSecurityattributes;
  1238.                      CreationDisposition:Cardinal;Flags:Cardinal;Temp:Cardinal) : integer;
  1239. begin
  1240.   if isUnicode then
  1241.    Result := createfilew(lpFilename,access,share,SecAttr,Creationdisposition,flags,temp) else
  1242.    Result := createfilea(PAnsichar( AnsiString(lpFilename)),access,share,SecAttr,Creationdisposition,flags,temp)
  1243. end;
  1244.  
  1245. //some Delphi veriosn do not take the Int64 overload
  1246. function FileSeek(Handle: Integer; const Offset: Int64; Origin: Integer): Int64;
  1247. begin
  1248.   Result := Offset;
  1249.   Int64Rec(Result).Lo := SetFilePointer(THandle(Handle), Int64Rec(Result).Lo,@Int64Rec(Result).Hi, Origin);
  1250. end;
  1251.  
  1252. function TSevenZip.AppendSlash( sDir: widestring ): widestring;
  1253. begin
  1254.   if ( sDir <> '' ) and ( sDir[ Length( sDir ) ] <> '\' ) then
  1255.     Result := sDir + '\' else
  1256.     Result := sDir;
  1257. end;
  1258.  
  1259. procedure TSevenZip.SetVolumeSize( const Value: Integer );
  1260. begin
  1261. // Shadow 27.11.2006
  1262.   if not FSFXCreate then
  1263.     FVolumeSize := Value
  1264.   else begin
  1265.     if ( Value > 0 ) and ( Value < FSFXOffset ) then
  1266.       FVolumeSize := FSFXOffset + 7
  1267.     else FVolumeSize := Value;
  1268.   end;
  1269. end;
  1270.  
  1271. procedure TSevenZip.SetSFXCreate( const Value: Boolean );
  1272.  
  1273.   function FileSizeW( fn: WideString ): DWORD;
  1274.   var
  1275.     f: Integer;
  1276.   begin
  1277.     Result := 0;
  1278.     f := CreateFile_( PwideChar( fn ), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0 );
  1279.     if dword(f)=INVALID_HANDLE_VALUE then Exit;               //FHO  20.01.2007
  1280.     try
  1281.       Result := FileSeek( f, int64(0), soFromEnd );
  1282.     finally
  1283.       FileClose( f );
  1284.     end;
  1285.   end;
  1286. var
  1287.   s: Int64;
  1288. begin
  1289. // Shadow 27.11.2006
  1290.   FSFXCreate := FALSE;
  1291.   if Value then begin
  1292.     s := FileSizeW( FSFXModule );
  1293.     if ( s > 0 ) then begin // FileExists
  1294.       if ( ( FVolumeSize > 0 ) and ( FVolumeSize < s + 7 ) ) then FVolumeSize := s + 7;
  1295.       FSFXOffset := s;
  1296.       FSFXCreate := TRUE;
  1297.     end;
  1298.   end;
  1299. end;
  1300.  
  1301. function FileTimeToDateTime( const rFileTime: TFileTime; const Localize: Integer = 0 ): TDateTime;
  1302. var
  1303.   dOffset: Double;
  1304.   rWork: TFileTime;
  1305. begin
  1306.   // offset to or from local time
  1307.   if Localize > 0 then
  1308.     FileTimeToLocalFileTime( rFileTime, rWork )
  1309.   else if Localize < 0 then
  1310.     LocalFileTimeToFileTime( rFileTime, rWork )
  1311.   else begin
  1312.     rWork := rFileTime;
  1313.   end;
  1314.  
  1315.   dOffset := 0.0000001 * ( ( Int64( rWork.dwHighDateTime ) shl 32 ) or rWork.dwLowDateTime );
  1316.   dOffset := dOffset / ( 60 * 60 * 24 );
  1317.   Result := EncodeDate( 1601, 1, 1 ) + dOffset;
  1318. end;
  1319.  
  1320. procedure SortDWord( var A: array of DWord; iLo, iHi: DWord );
  1321. var
  1322.   Lo, Hi, Mid, T: DWord;
  1323. begin
  1324.     Lo := iLo;
  1325.     Hi := iHi;
  1326.     Mid := A[ ( Lo + Hi ) div 2 ];
  1327.     repeat
  1328.       while A[ Lo ] < Mid do Inc( Lo );
  1329.       while A[ Hi ] > Mid do Dec( Hi );
  1330.       if Lo <= Hi then
  1331.       begin
  1332.         T := A[ Lo ];
  1333.         A[ Lo ] := A[ Hi ];
  1334.         A[ Hi ] := T;
  1335.         Inc( Lo );
  1336.         if Hi > 0 then Dec( Hi ); //Using DWord and not Integers
  1337.       end;
  1338.     until Lo > Hi;
  1339.     if Hi > iLo then SortDWord( A, iLo, Hi );
  1340.     if Lo < iHi then SortDWord( A, Lo, iHi );
  1341. end;
  1342.  
  1343. function DriveIsRemovable( Drive: WideString ): Boolean;
  1344. var
  1345.   DT: Cardinal;
  1346. begin
  1347.   DT := GetDriveTypeW( PWideChar( Drive ) );
  1348.   Result := ( DT <> DRIVE_FIXED );
  1349. end;
  1350.  
  1351. function TryStrToInt_( const S: string; out Value: Integer ): Boolean;
  1352. var
  1353.    E: Integer;
  1354. begin
  1355.    Val( S, Value, E );
  1356.    Result := ( E = 0 );
  1357. end;
  1358.  
  1359.  
  1360. //------------------------------------------------------------------------------------------------
  1361. //  End common functions
  1362. //--------------------------------------------------------------------------------------------------
  1363.  
  1364. //--------------------------------------------------------------------------------------------------
  1365. //--------------------------------------------------------------------------------------------------
  1366. //-------------------Start SevenZip Interface -----------------------------------------------
  1367. //--------------------------------------------------------------------------------------------------
  1368. //--------------------------------------------------------------------------------------------------
  1369.  
  1370. function TInterfacedObject.QueryInterface( const IID: TGUID; out Obj ): HResult;
  1371. const
  1372.   E_NOINTERFACE = HResult( $80004002 );
  1373. begin
  1374.   if GetInterface( IID, Obj ) then
  1375.   begin
  1376.     Result := 0;
  1377. {$IFDEF UseLog}
  1378.     Log( 'INTERFACEOK:' + ClassName + ' ' + GUIDToString( IID ) );
  1379. {$ENDIF}
  1380.   end else
  1381.   begin
  1382.     Result := E_NOINTERFACE;
  1383. {$IFDEF UseLog}
  1384.     Log( '  NOINTERFACE: ' + ClassName + ' ' + GUIDToString( IID ) );
  1385. {$ENDIF}
  1386.   end;
  1387. end;
  1388.  
  1389. function TInterfacedObject._AddRef: Integer;
  1390. begin
  1391.   Result := InterlockedIncrement( FRefCount );
  1392. end;
  1393.  
  1394. function TInterfacedObject._Release: Integer;
  1395. begin
  1396.   Result := InterlockedDecrement( FRefCount );
  1397.   if Result = 0 then
  1398.     Destroy;
  1399. end;
  1400.  
  1401. procedure TInterfacedObject.AfterConstruction;
  1402. begin
  1403. // Release the constructor's implicit refcount
  1404.   InterlockedDecrement( FRefCount );
  1405. end;
  1406.  
  1407. procedure TInterfacedObject.BeforeDestruction;
  1408. begin
  1409.   //if RefCount <> 0 then Error( reInvalidPtr );
  1410. end;
  1411.  
  1412. // Set an implicit refcount so that refcounting
  1413. // during construction won't destroy the object.
  1414. class function TInterfacedObject.NewInstance: TObject;
  1415. begin
  1416.   Result := inherited NewInstance;
  1417.   TInterfacedObject( Result ).FRefCount := 1;
  1418. end;
  1419.  
  1420. constructor TMyArchiveUpdateCallback.Create( Owner: TSevenZip );
  1421. begin
  1422.   inherited Create;
  1423.   FSevenzip := Owner;
  1424. // Shadow 29.11.2006
  1425.   if Assigned( FSevenzip ) then
  1426.     FPassword := FSevenzip.Password
  1427.   else FPassword := '';
  1428. end;
  1429.  
  1430. function TMyArchiveUpdateCallback.GetUpdateItemInfo( index: DWORD;
  1431.   newData: PInteger; // 1 - new data, 0 - old data
  1432.   newProperties: PInteger; // 1 - new properties, 0 - old properties
  1433.   indexInArchive: PDWORD // -1 if there is no in archive, or if doesn't matter
  1434.   ): Integer; stdcall;
  1435. begin
  1436. {$IFDEF UseLog}
  1437.   Log( Format( 'TMyArchiveUpdateCallback.GetUpdateItemInfo( %d )', [ index ] ) );
  1438. {$ENDIF}
  1439.   if newData <> nil then newData^ := 1;
  1440.   if newProperties <> nil then newProperties^ := 1;
  1441.   if indexInArchive <> nil then indexInArchive^ := DWORD( -1 );
  1442.   Result := S_OK;
  1443. end;
  1444.  
  1445. function TMyArchiveUpdateCallback.CryptoGetTextPassword2( passwordIsDefined: PInteger; var Password: PWideChar ): Integer;
  1446. begin
  1447.   if Length( FPassword ) > 0 then begin
  1448.     passwordIsDefined^ := Integer( Bool( TRUE ) );
  1449.     Password := SysAllocString( @FPassword[ 1 ] );
  1450.     Result := S_OK;
  1451.   end else begin
  1452.     passwordIsDefined^ := Integer( Bool( FALSE ) );
  1453.     Result := S_OK;
  1454.   end;
  1455. end;
  1456.  
  1457. function TMyArchiveUpdateCallback.GetProperty( index: DWORD; propID: PROPID; value: PPROPVARIANT ): Integer; stdcall;
  1458. var
  1459.   sz: WideString;
  1460. begin
  1461. {$IFDEF UseLog}
  1462.   Log( Format( 'TMyArchiveUpdateCallback.GetProperty( %d, %s ( %d ), %.8x )', [ index, PropIDToString( propID ), propID, Integer( value ) ] ) );
  1463. {$ENDIF}
  1464.   Result := S_OK;
  1465.   case propID of
  1466.     //kpidPath ( 3 ) VT_BSTR ( 8 )
  1467.     kpidPath:
  1468.     begin
  1469.       value^.vt := VT_BSTR;
  1470.  
  1471. //get relative path if wanted
  1472.       sz := Files[ index ];
  1473.       if rootdir <> '' then
  1474.       begin
  1475.         if Uppercasew_( copy( sz,1,length( rootdir ) ) ) = rootdir then
  1476.           delete( sz,1,length( rootdir ) );
  1477.       end;
  1478.  
  1479. //User set filename in archive if wanted
  1480.       if assigned( Fsevenzip.OnSetAddName ) then
  1481.         Fsevenzip.OnSetAddName( Fsevenzip, Index, sz );
  1482.  
  1483. //remove drive / Include drive if wanted
  1484.       if sz[ 2 ] = ':' then
  1485.         begin
  1486.          if CharInSet(sz[ 1 ], [ 'A'..'Z','a'..'z' ]) then
  1487.            if ( AddIncludeDriveLetter in Fsevenzip.FAddOptions ) then //include
  1488.             delete( sz,2,1 )
  1489.            else
  1490.              delete( sz,1,3 );
  1491.         end;
  1492.  
  1493. //just store filename
  1494.       if ( AddStoreOnlyFilename in Fsevenzip.FAddOptions ) then
  1495.        GetfilenameW( sz );
  1496.  
  1497. //rg 07.11.2006 StringToOleStr( )
  1498.       value^.bstrVal := Pwidechar( sz );
  1499.     end;
  1500.     //kpidAttributes ( 9 ) VT_UI4 ( 19 )
  1501.     kpidAttributes:
  1502.     begin
  1503.       value^.vt := VT_UI4;
  1504.       value^.ulVal := Files_Attr[ index ];//filegetattr( files[ index ] );
  1505.     end;
  1506.     kpidCreationTime:
  1507.     begin
  1508.       value^.vt := VT_FILETIME;
  1509.  
  1510.       value^.filetime.dwLowDateTime := 0;
  1511.       value^.filetime.dwHighDateTime := 0;
  1512.     end;
  1513.     kpidLastAccessTime:
  1514.     begin
  1515.       value^.vt := VT_FILETIME;
  1516.       value^.filetime.dwLowDateTime := 0;
  1517.       value^.filetime.dwHighDateTime := 0;
  1518.     end;
  1519.     //kpidLastWriteTime ( 12 ) VT_FILETIME ( 64 )
  1520.     kpidLastWriteTime:
  1521.     begin
  1522.       value^.vt := VT_FILETIME;
  1523.       value^.filetime.dwLowDateTime := Files_Date[ index ].dwLowDateTime;;
  1524.       value^.filetime.dwHighDateTime := Files_Date[ index ].dwHighDateTime;
  1525.     end;
  1526.     kpidIsFolder:
  1527.     begin
  1528.       value^.vt := VT_BOOL;
  1529.       value^.boolVal := ( Files_Attr[ index ] and faDirectory ) <> 0; //false
  1530.     end;
  1531.     kpidIsAnti:
  1532.     begin
  1533.       value^.vt := VT_BOOL;
  1534.       value^.boolVal := False;
  1535.     end;
  1536.     //kpidSize ( 7 ) VT_UI8 ( 21 )
  1537.     kpidSize:
  1538.     begin
  1539.       value^.vt := VT_UI8;
  1540.       value^.uhVal.QuadPart := Files_size[ index ];
  1541.     end;
  1542.   else
  1543. {$IFDEF UseLog}
  1544.     Log( 'Asking for unknown property' );
  1545. {$ENDIF}
  1546.     Result := S_FALSE;
  1547.   end;
  1548. end;
  1549.  
  1550. function TMyArchiveUpdateCallback.GetStream( index: DWORD; var inStream: ISequentialInStream ): Integer; stdcall;
  1551. begin
  1552. {$IFDEF UseLog}
  1553.   Log( 'TMyArchiveUpdateCallback.GetStream' );
  1554. {$ENDIF}
  1555.   Fprogressfile := files[ index ];
  1556.   Fprogressfilesize := files_size[ index ];
  1557.   Fprogressfilepos := 0;
  1558.   inStream := TMyStreamReader.Create( FSevenZip, Files[ index ], FALSE );
  1559.   Result := S_OK;
  1560. end;
  1561.  
  1562. function TMyArchiveUpdateCallback.SetOperationResult( operationResult: Integer ): Integer; stdcall;
  1563. begin
  1564. {$IFDEF UseLog}
  1565.   Log( Format( 'TMyArchiveUpdateCallback.SetOperationResult( %d )', [ operationResult ] ) );
  1566. {$ENDIF}
  1567.   Result := S_OK;
  1568. end;
  1569.  
  1570. function TMyArchiveUpdateCallback.SetTotal( total: Int64 ): Integer; stdcall;
  1571. begin
  1572. {$IFDEF UseLog}
  1573.   Log( Format( 'TMyArchiveUpdateCallback.SetTotal( %d )', [ total ] ) );
  1574. {$ENDIF}
  1575.   Result := S_OK;
  1576. end;
  1577.  
  1578. function TMyArchiveUpdateCallback.SetCompleted( const completeValue: PInt64 ): Integer; stdcall;
  1579. begin
  1580. /// Progressfile - Newfile
  1581. /// Do it here because it works with Multithreaded 7za interaction.
  1582. {$IFDEF UseLog}
  1583.   Log( Format( 'TMyArchiveUpdateCallback.SetCompleted( %d )', [ completeValue^ ] ) );
  1584. {$ENDIF}
  1585.  
  1586. //fileprogress
  1587.    if ( FProgressFilePos = 0 ) then
  1588.       if assigned( Fsevenzip.OnAddFile ) then Fsevenzip.onAddFile( Fsevenzip,FProgressFile,FProgressFileSize );
  1589.    FProgressFilePos := FProgressFilePos + ( completeValue^ - FLastPos );
  1590.    FLastPos := completeValue^;
  1591.  
  1592. //full and file progress position
  1593.    if assigned( Fsevenzip.OnProgress ) then Fsevenzip.OnProgress( Fsevenzip,FProgressFile,completeValue^,FProgressFilePos );
  1594.  
  1595.   Result := S_OK;
  1596. //rg 24.06
  1597. //User cancel operation
  1598.   if FSevenzip.FMainCancel then
  1599.    begin
  1600.      FSevenZip.ErrCode:=FUsercancel;                           //FHO 21.01.2007
  1601.      if assigned( Fsevenzip.onMessage ) then
  1602.        Fsevenzip.OnMessage( Fsevenzip,FUsercancel,c7zipResMsg[FUsercancel], FProgressFile );  //FHO 21.01.2007
  1603.      Result := S_FALSE;
  1604.    end;
  1605. end;
  1606.  
  1607.  
  1608. constructor TMyArchiveExtractCallback.Create( Owner: TSevenZip );
  1609. begin
  1610.   inherited Create;
  1611.   FSevenzip := Owner;
  1612. // Shadow 29.11.2006
  1613.   if Assigned( FSevenzip ) then
  1614.     FPassword := FSevenzip.Password
  1615.   else FPassword := '';
  1616. end;
  1617.  
  1618. function TMyArchiveExtractCallback.GetStream( index: DWORD;
  1619.   out outStream: ISequentialOutStream; askExtractMode: DWORD ): Integer; stdcall;
  1620. var
  1621.  path: Propvariant;
  1622.  size: Propvariant;
  1623.  date: Propvariant;
  1624.  attr: Propvariant;
  1625.    sz, origName: Widestring;
  1626.    fe,DoOverwrite: boolean;
  1627. //   fHnd: Integer;
  1628.   MyLastError:Integer;                                           //FHO 22.01.2007
  1629. begin
  1630. {$IFDEF UseLog}
  1631.   Log( Format( '__TMyArchiveExtractCallback.GetStream( %d, %.8x, %d )', [ index, Integer( outStream ), askExtractMode ] ) );
  1632. {$ENDIF}
  1633.   DoOverwrite := ExtractOverwrite in FsevenZip.FExtractOptions;
  1634.   path.vt := VT_EMPTY;
  1635.   size.vt := VT_EMPTY;
  1636.   date.vt := VT_EMPTY;
  1637.   attr.vt := VT_EMPTY;
  1638.  
  1639. //Cancel Operation
  1640.   if self.FSevenzip.FMainCancel then
  1641.    begin
  1642.     outStream := nil;
  1643.     result := S_FALSE;
  1644.     exit;
  1645.    end;
  1646.  
  1647.   Case askExtractMode of
  1648.     kExtract:  begin
  1649.  
  1650.                  FSevenzip.inA.GetProperty( index, kpidPath, path );
  1651.                  FSevenzip.inA.GetProperty( index, kpidSize, size );
  1652.                  FSevenzip.inA.GetProperty( index, kpidattributes, attr );
  1653.                  FSevenzip.inA.GetProperty( index, kpidLastWriteTime, date );
  1654.  
  1655. //rg 23.8.06
  1656.                  if ExtractNoPath in FSevenzip.FExtractOptions then
  1657.                    sz := FExtractDirectory + extractfilenameW( path.bstrVal )
  1658.                   else
  1659.                    sz := FExtractDirectory + path.bstrVal;
  1660.  
  1661.                  origName := sz;
  1662.  
  1663.                  if assigned( Fsevenzip.OnSetExtractName ) then
  1664.                    Fsevenzip.OnSetExtractName( Fsevenzip,index, sz );
  1665.  
  1666.  
  1667.                  if not DoOverwrite then
  1668.                   if FileExists_( sz ) then
  1669.                    begin
  1670.                      if assigned( Fsevenzip.OnExtractOverwrite ) then
  1671.                          Fsevenzip.OnExtractOverwrite( Fsevenzip, sz, DoOverwrite );
  1672.  
  1673.                      if not DoOverwrite then
  1674.                       begin
  1675.                        Result := S_OK;
  1676.                        outStream := nil;
  1677.                        exit;
  1678.                       end;
  1679.                      end;
  1680.  
  1681.                     FProgressFile := sz;
  1682.                     FProgressFilePos := 0;
  1683.                     FprogressFileSize := size.uhVal.QuadPart;
  1684.  
  1685.                  if ( attr.uiVal and ( 1 shl 4 ) ) <> 0 then
  1686.                   begin
  1687.                    if isUnicode then
  1688.                      ForceDirectoriesW( sz, attr.uiVal )
  1689.                     else
  1690.                      ForceDirectories(String(sz));
  1691.                   end
  1692.                  else
  1693.                   begin
  1694.                     FFilestoextract := FFilestoextract - 1;
  1695.                     if FFilestoextract = 0 then FLastFileToExt := true;
  1696.                     outStream := nil;
  1697.                     fe := FileExists_( sz );
  1698.  
  1699.                     if ( not fe ) or ( fe and DoOverwrite ) then begin
  1700.                       if isUnicode then
  1701.                         ForceDirectoriesW( ExtractFilePathW( sz ), attr.uiVal )
  1702.                        else
  1703.                         ForceDirectories(extractfilepath( String( sz ) ) );
  1704.                     try
  1705.                       outStream := TMyStreamWriter.Create(@MyLastError ,sz,
  1706.                                                                //FHO 22.01.2007
  1707.                                      FileTimeToDateTime( date.filetime, 2 ), attr.lVal );
  1708.                     except
  1709.                       outStream := nil;
  1710.                       Result := S_FALSE;
  1711.                       FSevenzip.LastError:=MyLastError;         //FHO 22.01.2007
  1712.                       FSevenzip.ErrCode:=FNoFileCreated;
  1713.                       if assigned( FsevenZip.onmessage ) then
  1714.                         FsevenZip.onmessage( FsevenZip, FNoFileCreated, c7zipResMsg[FNoFileCreated],origName);
  1715.                       Exit;
  1716. // did not work here need another place !
  1717. // if assigned( FsevenZip.onmessage ) then FsevenZip.onmessage( FsevenZip, 2, 'Could not create file', origName );
  1718.                     end;
  1719.                   end;
  1720.               end;
  1721.              end;
  1722.     ktest   : begin
  1723.                  FSevenzip.inA.GetProperty( index, kpidPath, path );
  1724.                  FSevenzip.inA.GetProperty( index, kpidSize, size );
  1725.                  FProgressFile := path.bstrVal;
  1726.                  FProgressFilePos := 0;
  1727.                  FprogressFileSize := size.uhVal.QuadPart ;
  1728.                end;
  1729.     kskip   : begin
  1730.                end;
  1731.   end;
  1732.   Result := S_OK;
  1733. end;
  1734. // GetStream OUT: S_OK - OK, S_FALSE - skeep this file
  1735.  
  1736. function TMyArchiveExtractCallback.PrepareOperation( askExtractMode: Integer ): Integer; stdcall;
  1737. begin
  1738. {$IFDEF UseLog}
  1739.   Log( Format( 'TMyArchiveExtractCallback.PrepareOperation( %d )', [ askExtractMode ] ) );
  1740. {$ENDIF}
  1741.   Result := S_OK;
  1742. end;
  1743.  
  1744. function TMyArchiveExtractCallback.SetOperationResult( resultEOperationResult: Integer ): Integer; stdcall;
  1745. begin
  1746.   Result := S_OK;
  1747. {$IFDEF UseLog}
  1748.   Log( Format( 'TMyArchiveExtractCallback.SetOperationResult( %d )', [ resultEOperationResult ] ) );
  1749. {$ENDIF}
  1750.   case resultEOperationResult of
  1751.     kOK               : FSevenzip.ErrCode:=FNoError;
  1752.     kUnSupportedMethod: begin                                  //FHO 21.01.2007
  1753.                           FSevenzip.ErrCode:=FUnsupportedMethod;
  1754.                           if assigned( Fsevenzip.onmessage ) then
  1755.                             Fsevenzip.onmessage( Fsevenzip, FUnsupportedMethod, c7zipResMsg[FUnsupportedMethod], FProgressFile );
  1756.                         end;
  1757.     kDataError        : begin                                  //FHO 21.01.2007
  1758.                           FSevenzip.ErrCode:=FDataError;
  1759.                           if assigned( Fsevenzip.onmessage ) then
  1760.                             Fsevenzip.onmessage( Fsevenzip, FDataError, c7zipResMsg[FDataError], FProgressFile );
  1761.                         end;
  1762.     kCRCError         : begin                                  //FHO 21.01.2007
  1763.                           FSevenzip.ErrCode:=FCRCError;
  1764.                           if assigned( Fsevenzip.onmessage ) then
  1765.                           Fsevenzip.onmessage( Fsevenzip, FCRCError, c7zipResMsg[FCRCError], FProgressFile );
  1766.                         end;
  1767.   end;
  1768.  
  1769.   if FLastFileToExt then FAllFilesExt := true; //no more files to extract, we can stop
  1770. end;
  1771.  
  1772. function TMyArchiveExtractCallback.SetTotal( total: Int64 ): Integer; stdcall;
  1773. begin
  1774. {$IFDEF UseLog}
  1775.   Log( Format( 'TMyArchiveExtractCallback.SetTotal( %d )', [ total ] ) );
  1776. {$ENDIF}
  1777.  
  1778. //all filesizes also skipped ones
  1779.   if FFilestoextract = 0 then // we extract all files, so we set FMaxProgress here
  1780.      if assigned( FSevenzip.OnPreProgress ) then FSevenzip.OnPreProgress( FSevenzip,total );
  1781.   Result := S_OK;
  1782. end;
  1783.  
  1784. function TMyArchiveExtractCallback.SetCompleted( const completeValue: PInt64 ): Integer; stdcall;
  1785. begin
  1786.  
  1787.    if ( FProgressFilePos = 0 ) then
  1788.       if assigned( Fsevenzip.OnExtractFile ) then Fsevenzip.onExtractfile( Fsevenzip,FProgressFile,FProgressFileSize );
  1789.  
  1790.    FProgressFilePos := FProgressFilePos + ( completeValue^ - FLastPos );
  1791.    FLastPos := completeValue^;
  1792.  
  1793. //full and file progress position
  1794.    if assigned( Fsevenzip.OnProgress ) then Fsevenzip.OnProgress( Fsevenzip,FProgressFile,completeValue^,FProgressFilePos );
  1795.  
  1796. {$IFDEF UseLog}
  1797.   Log( Format( 'TMyArchiveExtractCallback.SetCompleted( %d )', [ completeValue^ ] ) );
  1798. {$ENDIF}
  1799.   Result := S_OK;
  1800.  
  1801.   //have all files extracted. Could stop
  1802.   //User cancel operation
  1803.   if self.FAllFilesExt then Result := S_FALSE;
  1804.  
  1805.   if  Fsevenzip.FMainCancel then begin
  1806.      Result := S_FALSE;
  1807.      FSevenzip.ErrCode:=FUsercancel;                           //FHO 21.01.2007
  1808.      if assigned( Fsevenzip.onMessage ) then
  1809.        Fsevenzip.OnMessage( Fsevenzip, FUsercancel, c7zipResMsg[FUsercancel], FProgressFile );
  1810.    end;
  1811. end;
  1812.  
  1813.  
  1814. function TMyArchiveExtractCallback.CryptoGetTextPassword( var Password: PWideChar ): Integer;
  1815. begin
  1816.   if Length( FPassword ) > 0 then begin
  1817.     Password := SysAllocString( @FPassword[ 1 ] );
  1818.     Result := S_OK;
  1819.   end else Result := S_FALSE;
  1820. end;
  1821.  
  1822.  
  1823. {============ TMyOpenarchiveCallbackReader =================================================}
  1824.  
  1825.  
  1826. function TMyArchiveOpenCallback.CryptoGetTextPassword( var Password: PWideChar ): Integer;
  1827. begin
  1828.   if Length( FPassword ) > 0 then begin
  1829.     Password := SysAllocString( @FPassword[ 1 ] );
  1830.     Result := S_OK;
  1831.   end else Result := S_FALSE;
  1832. end;
  1833.  
  1834. constructor TMyArchiveOpenCallback.Create( Owner: TSevenZip );
  1835. begin
  1836.   inherited Create;
  1837.   FSevenzip := Owner;
  1838. // Shadow 29.11.2006
  1839.   if Assigned( FSevenzip ) then
  1840.     FPassword := FSevenzip.Password
  1841.   else FPassword := '';
  1842. end;
  1843.  
  1844. function TMyArchiveOpenCallback.SetTotal( const files: Int64; const bytes: Int64 ): Integer; stdcall;
  1845. begin
  1846. //
  1847. Result := S_OK; //LifePower 07.01.2007
  1848. end;
  1849.  
  1850. function TMyArchiveOpenCallback.SetCompleted( const files: Int64; const bytes: Int64 ): Integer; stdcall;
  1851. begin
  1852. //
  1853. Result := S_OK;
  1854. end;
  1855.  
  1856. {============ TMyStreamReader =================================================}
  1857.  
  1858. function TMyStreamReader.Seek( Offset: Int64; SeekOrigin: DWORD; NewPosition: PInt64 ): Integer; stdcall;
  1859. begin
  1860. //  frmMain.mmoLog.Lines.Add( '-> Seek ' + IntToStr( offset ) + ' ' + IntToStr( seekOrigin ) );
  1861.   Result := S_OK;
  1862.   case SeekOrigin of
  1863.     soFromBeginning: arcPosition := Offset;
  1864.     soFromCurrent: arcPosition := arcPosition + Offset;
  1865.     soFromEnd: begin
  1866.       if arcSize > 0 then
  1867.         arcPosition := arcSize + Offset
  1868.       else Result := S_FALSE;
  1869.     end;
  1870.   end;
  1871.   if newPosition <> nil then newPosition^ := arcPosition;
  1872. end;
  1873.  
  1874. function TMyStreamReader.Read( var Data; Size: DWORD; ProcessedSize: PDWORD ): Integer; stdcall;
  1875. var
  1876.   fIdx: Integer;
  1877.   fPos : Int64;                                                             //RG 26.01.2007
  1878.   pSize, Read: DWORD;
  1879.   Vsize : Int64;
  1880.   Buff: PChar;
  1881. begin
  1882.   //frmMain.mmoLog.Lines.Add( '-> Read ' + Format( '%.8x', [ Integer( data ) ] ) + ' ' + IntToStr( size ) );
  1883.   if FArchive then begin
  1884.     if ( Length( Files ) <= 1 ) and ( arcPosition + Size > Files[ 0 ].Size ) then begin
  1885.       arcSize := arcPosition + Size;
  1886.       if not OpenLastVolume then begin
  1887.         Result := S_FALSE;
  1888.         Exit;
  1889.       end else FMultivolume := TRUE;
  1890.     end;
  1891.   end;
  1892.  
  1893.   if ( not FArchive ) or ( not FMultivolume ) then begin
  1894.     FileSeek( Files[ 0 ].Handle, arcPosition, soFromBeginning );
  1895.     if not ReadFile( Files[ 0 ].Handle, Data, Size, pSize, nil ) then begin
  1896.       MyLastError:=GetLastError;                               //FHO 22.01.2007
  1897.       pSize := 0;
  1898.     end;
  1899.     Inc( arcPosition, pSize );
  1900.     if ProcessedSize <> nil then ProcessedSize^ := pSize;
  1901.     Result := S_OK;
  1902.     Exit;
  1903.   end;
  1904.  
  1905.   fIdx := -1;
  1906.   vSize := 0;
  1907.   repeat
  1908.     Inc( fIdx );
  1909.     if ( Files[ fIdx ].Handle = INVALID_HANDLE_VALUE ) and ( not OpenVolume( fIdx + 1 ) ) then begin  //FHO 20.01.2007
  1910.       Result := S_FALSE;
  1911.       Exit;
  1912.     end;
  1913.     vSize := vSize + Files[ fIdx ].Size;
  1914.   until arcPosition < vSize;
  1915.  
  1916.   Buff := @Data;
  1917.   fPos := arcPosition - ( vSize - Files[ fIdx ].Size );
  1918.   Read := 0;
  1919.   while Read < Size do begin
  1920.     if Read > 0 then begin
  1921.       with Files[ fIdx - 1 ] do begin
  1922.         FileClose( Handle );
  1923.         Handle := INVALID_HANDLE_VALUE;                        //FHO 20.01.2007
  1924.         Size := 0;
  1925.       end;
  1926.       if ( Files[ fIdx ].Handle = INVALID_HANDLE_VALUE ) and ( not OpenVolume( fIdx + 1 ) ) then begin                                        //FHO 20.01.2007
  1927.         Result := S_FALSE;
  1928.         Exit;
  1929.       end;
  1930.     end;
  1931.     FileSeek( Files[ fIdx ].Handle, fPos, soFromBeginning );
  1932.     pSize := Size - Read;
  1933.     if Files[ fIdx ].Size < fPos + pSize then pSize := Files[ fIdx ].Size - fPos;
  1934.     if not ReadFile( Files[ fIdx ].Handle, Buff[ Read ], pSize, pSize, nil ) then begin
  1935.       MyLastError:=GetLastError;                               //FHO 22.01.2007
  1936.       Read := 0;
  1937.       Break;
  1938.     end;
  1939.     Inc( Read, pSize );
  1940.     Inc( fIdx );
  1941.     fPos := 0;
  1942.   end;
  1943.   Inc( arcPosition, Read );
  1944.   if Assigned( ProcessedSize ) then ProcessedSize^ := Read;
  1945.   if MyLastError=0 then
  1946.     Result := S_OK
  1947.   else
  1948.     Result := S_False;  
  1949. end;
  1950.  
  1951. function TMyStreamReader.ReadPart( var data; size: DWORD; processedSize: PDWORD ): Integer; stdcall;
  1952. begin
  1953.   //frmMain.mmoLog.Lines.Add( '-> ReadPart ' + IntToStr( size ) );
  1954.   Result := Read( Data, Size, ProcessedSize );
  1955. end;
  1956.  
  1957. function TMyStreamReader.GetSize( var size: Int64 ): Integer; stdcall;
  1958. begin
  1959.   //frmMain.mmoLog.Lines.Add( 'GetSize' );
  1960.   if arcSize > 0 then begin
  1961.     Size := arcSize;
  1962.     Result := S_OK;
  1963.   end else Result := S_FALSE;
  1964. end;
  1965.  
  1966. function TMyStreamReader.BrowseForFile( Title: PWideChar; var Name: WideString ): Boolean;
  1967. var
  1968.   OpenFileName: TOpenFilenameW;
  1969.   FileName: array[ 0..MAX_PATH - 1 ] of WideChar;
  1970.   s: WideString;
  1971. begin
  1972.   Result := FALSE;
  1973.   try
  1974.     s := ExtractFileNameW( Name );
  1975.     s := Copy( s, 1, Length( s ) - Length( ExtractFileExtW( Name ) ) );
  1976.     s := s + '-volumes'#0 + s + '.*'#0;
  1977.     FillChar( FileName, MAX_PATH, 0 );
  1978.  
  1979.     FillChar( OpenFileName, SizeOf( OpenFileName ), 0 );
  1980.  
  1981.     OpenFileName.lStructSize := SizeOf( OpenFileName );
  1982.     OpenFileName.hWndOwner := Application.Handle;
  1983.  
  1984.     OpenFileName.lpstrInitialDir := PWideChar( ExtractFilePathW( Name ) );
  1985.  
  1986.     OpenFileName.lpstrFile := @FileName;
  1987.     OpenFileName.nMaxFile := MAX_PATH;
  1988.  
  1989.     OpenFileName.lpstrFilter := @s[ 1 ];
  1990.     OpenFileName.nFilterIndex := 1;
  1991.     OpenFileName.Flags := OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST;
  1992.  
  1993.     if GetOpenFileNameW( OpenFileName ) then begin
  1994.       Name := FileName;
  1995.       Result := ( GetLastError = 0 );
  1996.     end else Result := FALSE;
  1997.   except
  1998.   end;
  1999. end;
  2000.  
  2001. function TMyStreamReader.OpenVolume( Index: Integer ): Boolean;
  2002. var
  2003.   i: Integer;
  2004.   s: WideString;
  2005.   fCancel: Boolean;
  2006. begin
  2007.   Result := FALSE;
  2008.  
  2009.   if Index <= 0 then
  2010.     Exit
  2011.   else if Index <= Length( Files ) then begin
  2012.     if Files[ Index - 1 ].Handle <> INVALID_HANDLE_VALUE then begin //FHO 20.01.2007
  2013.       Result := TRUE;
  2014.       Exit;
  2015.     end;
  2016.   end else begin
  2017.     i := Length( Files );
  2018.     while i < Index do begin
  2019.       SetLength( Files, i + 1 );
  2020.       Files[ i ].Handle := INVALID_HANDLE_VALUE;               //FHO 20.01.2007
  2021.       Files[ i ].Size := 0;
  2022.       Inc( i );
  2023.     end;
  2024.   end;
  2025.  
  2026.   Dec( Index );
  2027.   if Length( Files[ Index ].Name ) <= 0 then begin
  2028.     s := IntToStr( Index + 1 );
  2029.     while Length( s ) < 3 do s := '0' + s;
  2030. // Shadow 28.11.2006
  2031.     if Assigned( FSevenZip ) and FSevenZip.IsSFX then begin
  2032.       Files[ Index ].Name := arcName + '.' + s
  2033.     end else Files[ Index ].Name := Copy( arcName, 1, Length( arcName ) - Length( ExtractFileExtW( arcName ) ) ) + '.' + s;
  2034.   end;
  2035.  
  2036.   while Files[ Index ].Handle = INValid_Handle_Value do begin  //FHO 20.01.2007
  2037.     Files[ Index ].Handle := CreateFile_( PwideChar( Files[ Index ].Name ),
  2038.                                           GENERIC_READ,
  2039.                                           FILE_SHARE_READ,
  2040.                                           nil,
  2041.                                           OPEN_EXISTING, 0, 0 );
  2042.     if Files[ Index ].Handle = INVALID_HANDLE_VALUE then begin //FHO 20.01.2007
  2043.       if Assigned( FOnOpenVolume ) then begin
  2044.         FOnOpenVolume( Files[ Index ].Name, Files[ Index ].OnRemovableDrive, fCancel );
  2045.         if not fCancel then Continue;
  2046.       end else begin
  2047.         if BrowseForFile( 'Select volume', Files[ Index ].Name ) then Continue;
  2048.       end;
  2049.       Files[ Index ].Name := '';
  2050.       Result := FALSE;
  2051.       Exit;
  2052.     end;
  2053.     Files[ Index ].Size := FileSeek( Files[ Index ].Handle, int64(0), soFromEnd );
  2054.     FileSeek( Files[ Index ].Handle, int64(0), soFromBeginning );
  2055.   end;
  2056.  
  2057.   Result := ( Files[ Index ].Size > 0 );
  2058. end;
  2059.  
  2060. function TMyStreamReader.OpenNextVolume: Boolean;
  2061. begin
  2062.   Result := OpenVolume( Length( Files ) + 1 );
  2063. end;
  2064.  
  2065. function TMyStreamReader.OpenLastVolume: Boolean;
  2066. var
  2067.   Name: WideString;
  2068.   n: Integer;
  2069.  
  2070.  
  2071.   function GetLastVolumeFN(first:widestring):widestring;
  2072.   var n:integer;
  2073.       s,e,lastfound:widestring;
  2074.   begin
  2075.     Result := '';
  2076.     s:= ChangeFileExtW( first,'');
  2077.     lastfound := first;
  2078.     if not TryStrToInt_( Copy( ExtractFileExtW( first ), 2, MaxInt ), n) then exit;
  2079.     e:= '00' + inttostr(n);
  2080.  
  2081.     repeat
  2082.       lastfound := s + '.' + e;
  2083.       inc(n);
  2084.       e:= inttostr(n);
  2085.       while Length( e ) < 3 do e := '0' + e;
  2086.  
  2087.     until not fileexists_( s + '.' + e);
  2088.     Result := lastfound;
  2089.   end;
  2090.  
  2091. begin
  2092.   Result := FALSE;
  2093.   repeat
  2094. {
  2095.     if Assigned( FOnOpenVolume ) then begin
  2096.       Name := ChangeFileExtW( Files[ 0 ].Name, '.*' );
  2097.       FOnOpenVolume( Name, Files[ 0 ].OnRemovableDrive, Result );
  2098.       if Result then begin
  2099.         Result := FALSE;
  2100.         Exit;
  2101.       end;
  2102.     end else begin
  2103.       Name := arcName;
  2104.       if not BrowseForFile( 'Select last volume', Name ) then Exit;
  2105.     end;
  2106. }
  2107.    name := '';
  2108.    name := GetLastVolumeFN(Arcname);
  2109.    if name = '' then
  2110.     if not BrowseForFile( 'Select last volume', Name ) then Exit;
  2111.  
  2112. // Shadow 28.11.2006
  2113.     if Assigned( FSevenZip ) and FSevenZip.IsSFX then begin
  2114.       if UpperCaseW_( ChangeFileExtW( ExtractFileNameW( Name ), '' ) ) <>
  2115.          UpperCaseW_( ExtractFileNameW( Files[ 0 ].Name ) ) then Continue;
  2116.     end else begin
  2117.       if UpperCaseW_( ChangeFileExtW( ExtractFileNameW( Name ), ExtractFileExtW( Files[ 0 ].Name ) ) ) <>
  2118.          UpperCaseW_( ExtractFileNameW( Files[ 0 ].Name ) ) then Continue;
  2119.     end;
  2120.     if not TryStrToInt_( Copy( ExtractFileExtW( Name ), 2, MaxInt ), n ) then Continue;
  2121.   until n > 1;
  2122.   Result := OpenVolume( n );
  2123. end;
  2124.  
  2125. constructor TMyStreamReader.Create( Owner: TSevenZip; sz: Widestring; asArchive: Boolean );
  2126. begin
  2127.   inherited Create;
  2128.   arcName := sz;
  2129.   arcPosition := 0;
  2130.  
  2131.   FSevenZip := Owner;
  2132.   if Assigned( FSevenZip ) then begin
  2133.     if Owner.IsSFX then arcPosition := Owner.SFXOffset;
  2134.     FOnOpenVolume := FSevenZip.FOnOpenVolume;
  2135.   end else FOnOpenVolume := nil;
  2136.   FArchive := asArchive;
  2137.   FMultivolume := FALSE;
  2138.  
  2139.   SetLength( Files, 1 );
  2140.   Files[ 0 ].Name := arcName;
  2141.   Files[ 0 ].Handle := CreateFile_( PWideChar( Files[ 0 ].Name ), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0 );
  2142.   Files[ 0 ].Size := FileSeek( Files[ 0 ].Handle, int64(0), soFromEnd );
  2143.   Files[ 0 ].OnRemovableDrive := DriveIsRemovable( Copy( ExtractFilePathW( Files[ 0 ].Name ), 1, 2 ) );
  2144.  
  2145.   if not FArchive then
  2146.     arcSize := Files[ 0 ].Size
  2147.   else arcSize := 0;
  2148.  
  2149. //  frmMain.mmoLog.Lines.Add( IntToStr( fIn ) );
  2150. end;
  2151.  
  2152. destructor TMyStreamReader.Destroy;
  2153. var i: Integer;
  2154. begin
  2155.   if MyLastError <> ERROR_SUCCESS then
  2156.     fSevenZip.LastError := MyLastError;                          //FHO 22.01.2007
  2157.   for i := 0 to Length( Files ) - 1 do
  2158.   if Files[ i ].Handle <> INVALID_HANDLE_VALUE then begin  //FHO 20.01.2007
  2159.     FileClose( Files[ i ].Handle );
  2160.     Files[ i ].Name:='';                                       //FHO 20.01.2007
  2161.   end;
  2162.   SetLength( Files, 0 );
  2163.  
  2164. {$IFDEF UseLog}
  2165.   Log( 'TMyStreamReader.Destroy' );
  2166. {$ENDIF}
  2167.   inherited;
  2168. end;
  2169.  
  2170. {============ TMyStreamWriter =================================================}
  2171.  
  2172. function TMyStreamWriter.Write( const Data; Size: DWORD; ProcessedSize: PDWORD ): Integer; stdcall;
  2173. var
  2174.   fIdx: Integer;
  2175.   fPos: Int64;                                                                //RG26.01.2007
  2176.   pSize, Written: DWORD;
  2177.   Buff: PChar;
  2178. begin
  2179. {$IFDEF UseLog}
  2180.   Log( Format( '-> Write( %.8x, %d )', [ Integer( data ), size ] ) );
  2181. {$ENDIF}
  2182.  
  2183.   if arcVolumeSize > 0 then begin
  2184.     fIdx := ( arcPosition + Size ) div arcVolumeSize;
  2185.     while Length( Files ) < Integer( Succ( fIdx ) ) do CreateNewFile;
  2186.  
  2187.     fIdx := arcPosition div arcVolumeSize;
  2188.     fPos := arcPosition mod arcVolumeSize;
  2189.     Buff := @Data;
  2190.     Written := 0;
  2191.     while Written < Size do begin
  2192.       FileSeek( Files[ fIdx ].Handle, fPos, soFromBeginning );
  2193.       pSize := Size - Written;
  2194.       if arcVolumeSize < fPos + pSize then pSize := arcVolumeSize - fPos;
  2195.       if not WriteFile( Files[ fIdx ].Handle, Buff[ Written ], pSize, pSize, nil ) then begin
  2196.         MyLastError:=GetLastError;                             //FHO 22.01.2007
  2197.         Written := 0;
  2198.         Break;
  2199.       end;
  2200.       Inc( Written, pSize );
  2201.       Inc( fIdx );
  2202.       fPos := 0;
  2203.     end;
  2204.   end else begin
  2205.     FileSeek( Files[ 0 ].Handle, arcPosition, soFromBeginning );
  2206.     if not WriteFile( Files[ 0 ].Handle, Data, Size, Written, nil ) then begin
  2207.       MyLastError:=GetLastError;                              //FHO 22.01.2007
  2208.       Written := 0;
  2209.     end;
  2210.   end;
  2211.   Inc( arcPosition, Written );
  2212.   if arcPosition > arcSize then arcSize := arcPosition;
  2213.   if Assigned( ProcessedSize ) then ProcessedSize^ := Written;
  2214.   if MyLastError=0 then                                       //FHO 22.01.2007
  2215.     Result := S_OK
  2216.   else
  2217.     Result := S_FALSE;
  2218. end;
  2219.  
  2220. function TMyStreamWriter.WritePart( const Data; Size: DWORD; ProcessedSize: PDWORD ): Integer; stdcall;
  2221. begin
  2222.   Result := Write( Data, Size, ProcessedSize );
  2223. end;
  2224.  
  2225. function TMyStreamWriter.Seek( Offset: Int64; SeekOrigin: DWORD; NewPosition: PInt64 ): Integer; stdcall;
  2226. begin
  2227. {$IFDEF UseLog}
  2228.   Log( Format( 'TMyStreamWriter.Seek( %d, %d, %.8x )', [ offset, seekOrigin, Integer( newPosition ) ] ) );
  2229. {$ENDIF}
  2230.   case SeekOrigin of
  2231.     soFromBeginning: arcPosition := Offset;
  2232.     soFromCurrent: arcPosition := arcPosition + Offset;
  2233.     soFromEnd: arcPosition := arcSize + Offset;
  2234.   end;
  2235.   if arcPosition > arcSize then arcSize := arcPosition;
  2236.   if newPosition <> nil then newPosition^ := arcPosition;
  2237.   Result := S_OK;
  2238. end;
  2239.  
  2240. function TMyStreamWriter.SetSize( newSize: Int64 ): Integer; stdcall;
  2241. begin
  2242. {$IFDEF UseLog}
  2243.   Log( Format( 'TMyStreamWriter.SetSize( %d )', [ newSize ] ) );
  2244. {$ENDIF}
  2245.   Result := S_FALSE;
  2246. end;
  2247.  
  2248. destructor TMyStreamWriter.Destroy;
  2249. var
  2250.   i: Integer;
  2251. begin
  2252.   if Assigned(FPLastError) and
  2253.     (MyLastError<>ERROR_SUCCESS) then                          //FHO 22.01.2007
  2254.     FPLastError^:=MyLastError;                                 //FHO 22.01.2007
  2255.   for i := Low( Files ) to High( Files ) do begin
  2256.     FileClose( Files[ i ].Handle );                            //FHO 17.01.2007
  2257.     Files[ i ].Name:='';                                       //FHO 17.01.2007
  2258.   end;
  2259.   SetLength( Files, 0 );                                       //FHO 17.01.2007
  2260.  
  2261. {$IFDEF UseLog}
  2262.   Log( 'TMyStreamWriter.Destroy' );
  2263. {$ENDIF}
  2264.   inherited;
  2265. end;
  2266.  
  2267. function TMyStreamWriter.CreateNewFile: Boolean;
  2268. var
  2269.   i: Integer;
  2270.   s: WideString;
  2271. begin
  2272.   i := Length( Files );
  2273.   SetLength( Files, i + 1 );
  2274.   if arcVolumeSize > 0 then begin
  2275.     s := IntToStr( i + 1 );
  2276.     while Length( s ) < 3 do s := '0' + s;
  2277.     s := arcName + '.' + s;
  2278.   end else s := arcName;
  2279.  
  2280.   if arcCreateSFX and ( i = 0 ) then begin
  2281. // Shadow 27.11.2006
  2282.     Files[ 0 ].Name:=arcName;                                  //FHO 17.01.2007
  2283.     Files[ 0 ].Handle := CreateFile_( PwideChar( arcName ), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, arcAttr, 0 );
  2284.     if Files[ 0 ].Handle <> INVALID_HANDLE_VALUE then arcPosition := FileSeek( Files[ 0 ].Handle, int64(0), soFromEnd );  //FHO 20.01.2007
  2285.   end else begin
  2286.     Files[ i ].Name:=s;                                        //FHO 17.01.2007
  2287.     Files[ i ].Handle := CreateFile_( PwideChar( s ), GENERIC_READ or GENERIC_WRITE, 0, nil, CREATE_ALWAYS, arcAttr, 0 );
  2288.   end;
  2289.  
  2290.   if Files[ i ].Handle = INVALID_HANDLE_VALUE then begin       //FHO 20.01.2007
  2291.      MyLastError:=GetLastError;                                //FHO 22.01.2007
  2292.      Abort;
  2293.   end;
  2294.  
  2295.   MyLastError:=FileSetDate( Files[ i ].Handle, DateTimeToFileDate( arcDate ) );      //FHO 22.01.2007
  2296.   if MyLastError<>0 then                                       //FHO 22.01.2007
  2297.     Abort;
  2298.   Result := TRUE;
  2299. end;
  2300.  
  2301. constructor TMyStreamWriter.Create(PLastError:PInteger; sz: Widestring; //FHO 22.01.2007
  2302.                                  szDate: Tdatetime; FAttr: Cardinal; VolumeSize: Integer; CreateSFX: Boolean );
  2303. begin
  2304.   inherited Create;
  2305.   FPLastError:=PLastError;                                     //FHO 22.01.2007
  2306.   arcName := sz;
  2307.   arcDate := szDate;
  2308.   arcAttr := FAttr;
  2309.   arcCreateSFX := CreateSFX;
  2310.   arcVolumeSize := VolumeSize;
  2311.   arcPosition := 0;
  2312.   arcSize := 0;
  2313.   SetLength( Files, 0 );
  2314.   if not CreateNewFile then Abort;
  2315. end;
  2316.  
  2317.  
  2318. // ------------------------------------------------------------------------------------------
  2319. //functions for SevenZip
  2320. {$IFDEF UseLog}
  2321. function PropIDToString( propID: Integer ): string;
  2322. begin
  2323.   case propID of
  2324.     kpidNoProperty       : Result := 'kpidNoProperty';
  2325.     kpidHandlerItemIndex : Result := 'kpidHandlerItemIndex';
  2326.     kpidPath             : Result := 'kpidPath';
  2327.     kpidName             : Result := 'kpidName';
  2328.     kpidExtension        : Result := 'kpidExtension';
  2329.     kpidIsFolder         : Result := 'kpidIsFolder';
  2330.     kpidSize             : Result := 'kpidSize';
  2331.     kpidPackedSize       : Result := 'kpidPackedSize';
  2332.     kpidAttributes       : Result := 'kpidAttributes';
  2333.     kpidCreationTime     : Result := 'kpidCreationTime';
  2334.     kpidLastAccessTime   : Result := 'kpidLastAccessTime';
  2335.     kpidLastWriteTime    : Result := 'kpidLastWriteTime';
  2336.     kpidSolid            : Result := 'kpidSolid';
  2337.     kpidCommented        : Result := 'kpidCommented';
  2338.     kpidEncrypted        : Result := 'kpidEncrypted';
  2339.     kpidSplitBefore      : Result := 'kpidSplitBefore';
  2340.     kpidSplitAfter       : Result := 'kpidSplitAfter';
  2341.     kpidDictionarySize   : Result := 'kpidDictionarySize';
  2342.     kpidCRC              : Result := 'kpidCRC';
  2343.     kpidType             : Result := 'kpidType';
  2344.     kpidIsAnti           : Result := 'kpidIsAnti';
  2345.     kpidMethod           : Result := 'kpidMethod';
  2346.     kpidHostOS           : Result := 'kpidHostOS';
  2347.     kpidFileSystem       : Result := 'kpidFileSystem';
  2348.     kpidUser             : Result := 'kpidUser';
  2349.     kpidGroup            : Result := 'kpidGroup';
  2350.     kpidBlock            : Result := 'kpidBlock';
  2351.     kpidComment          : Result := 'kpidComment';
  2352.     kpidPosition         : Result := 'kpidPosition';
  2353.  
  2354.     kpidTotalSize        : Result := 'kpidTotalSize';
  2355.     kpidFreeSpace        : Result := 'kpidFreeSpace';
  2356.     kpidClusterSize      : Result := 'kpidClusterSize';
  2357.     kpidVolumeName       : Result := 'kpidVolumeName';
  2358.  
  2359.     kpidLocalName        : Result := 'kpidLocalName';
  2360.     kpidProvider         : Result := 'kpidProvider';
  2361.     kpidUserDefined      : Result := 'kpidUserDefined';
  2362.   else
  2363.     Result := 'unknown';
  2364.   end;
  2365. end;
  2366.  
  2367. function PropTypeToString( propType: Integer ): string;
  2368. begin
  2369.   case propType of
  2370.     VT_EMPTY          : Result := 'VT_EMPTY';
  2371.     VT_NULL           : Result := 'VT_NULL';
  2372.     VT_I2             : Result := 'VT_I2';
  2373.     VT_I4             : Result := 'VT_I4';
  2374.     VT_R4             : Result := 'VT_R4';
  2375.     VT_R8             : Result := 'VT_R8';
  2376.     VT_CY             : Result := 'VT_CY';
  2377.     VT_DATE           : Result := 'VT_DATE';
  2378.     VT_BSTR           : Result := 'VT_BSTR';
  2379.     VT_DISPATCH       : Result := 'VT_DISPATCH';
  2380.     VT_ERROR          : Result := 'VT_ERROR';
  2381.     VT_BOOL           : Result := 'VT_BOOL';
  2382.     VT_VARIANT        : Result := 'VT_VARIANT';
  2383.     VT_UNKNOWN        : Result := 'VT_UNKNOWN';
  2384.     VT_DECIMAL        : Result := 'VT_DECIMAL';
  2385.     VT_I1             : Result := 'VT_I1';
  2386.     VT_UI1            : Result := 'VT_UI1';
  2387.     VT_UI2            : Result := 'VT_UI2';
  2388.     VT_UI4            : Result := 'VT_UI4';
  2389.     VT_I8             : Result := 'VT_I8';
  2390.     VT_UI8            : Result := 'VT_UI8';
  2391.     VT_INT            : Result := 'VT_INT';
  2392.     VT_UINT           : Result := 'VT_UINT';
  2393.     VT_VOID           : Result := 'VT_VOID';
  2394.     VT_HRESULT        : Result := 'VT_HRESULT';
  2395.     VT_PTR            : Result := 'VT_PTR';
  2396.     VT_SAFEARRAY      : Result := 'VT_SAFEARRAY';
  2397.     VT_CARRAY         : Result := 'VT_CARRAY';
  2398.     VT_USERDEFINED    : Result := 'VT_USERDEFINED';
  2399.     VT_LPSTR          : Result := 'VT_LPSTR';
  2400.     VT_LPWSTR         : Result := 'VT_LPWSTR';
  2401.     VT_FILETIME       : Result := 'VT_FILETIME';
  2402.     VT_BLOB           : Result := 'VT_BLOB';
  2403.     VT_STREAM         : Result := 'VT_STREAM';
  2404.     VT_STORAGE        : Result := 'VT_STORAGE';
  2405.     VT_STREAMED_OBJECT: Result := 'VT_STREAMED_OBJECT';
  2406.     VT_STORED_OBJECT  : Result := 'VT_STORED_OBJECT';
  2407.     VT_BLOB_OBJECT    : Result := 'VT_BLOB_OBJECT';
  2408.     VT_CF             : Result := 'VT_CF';
  2409.     VT_CLSID          : Result := 'VT_CLSID';
  2410.   else
  2411.     Result := 'Unknown';
  2412.   end;
  2413. end;
  2414. {$ENDIF}
  2415.  
  2416. //--------------------------------------------------------------------------------------------------
  2417. //--------------------------------------------------------------------------------------------------
  2418. //-------------------End SevenZip Interface -------------------------------------------------
  2419. //--------------------------------------------------------------------------------------------------
  2420. //--------------------------------------------------------------------------------------------------
  2421.  
  2422. //--------------------------------------------------------------------------------------------------
  2423. //-----------------START DEBUG ONLY-----------------------------------------------------------------
  2424. //--------------------------------------------------------------------------------------------------
  2425. // For Debug only
  2426. // Add this to your MainForm public
  2427. {
  2428.  procedure LogMessage( var msg: TMessage ); message 9999;
  2429. }
  2430. {
  2431.   procedure TForm1.SevenZip1Message( Sender: TObject; ErrCode: Integer; Message: String );
  2432.   begin
  2433.    memo1.lines.add( message );
  2434.   end;
  2435. }
  2436. // and to Form.Activate this ( or set it when you want with e.g. a Button )
  2437. {
  2438.  sevenzipvcl.FMainhandle := form1.Handle;
  2439. }
  2440.  
  2441. {$IFDEF UseLog}
  2442. procedure Log( sz: string );
  2443. var
  2444.   p: PString;
  2445. begin
  2446.   p := new( PString );
  2447.   p^ := sz;
  2448.   PostMessage( fMainhandle, 9999, 0, Integer( p ) );
  2449. end;
  2450. {$ENDIF}
  2451.  
  2452. //--------------------------------------------------------------------------------------------------
  2453. //-----------------END DEBUG ONLY-------------------------------------------------------------------
  2454. //--------------------------------------------------------------------------------------------------
  2455.  
  2456. //------------------------------------------------------------------------------------------------
  2457. //------------------------------------------------------------------------------------------------
  2458. //-----------------Start SevenZip VCL-------------------------------------------------------
  2459. //------------------------------------------------------------------------------------------------
  2460.  
  2461. //------------------------------------------------------------------------------------------------
  2462. //constructor destructor
  2463. //------------------------------------------------------------------------------------------------
  2464. (*
  2465. procedure TSevenZip.LogMessage( var msg: TMessage );
  2466. begin
  2467.   if assigned( onMessage ) then OnMessage( Self,0,PString( msg.LParam )^ );
  2468.   Dispose( PString( msg.LParam ) );
  2469. end;
  2470. *)
  2471.  
  2472. constructor TSevenZip.Create( AOwner: TComponent );
  2473. var OSVerInfo : TOSVersionInfo;
  2474. {$IFDEF UseRes7zdll}
  2475.   MemoryStream: TResourceStream;
  2476. {$ENDIF}
  2477. begin
  2478.   inherited Create( AOwner );
  2479.   ffiles := TWideStringList_.Create;
  2480.   ResetCancel;
  2481.   FMainHandle := FHandle;
  2482.   FNumberOfFiles := -1;
  2483.   FPassword := '';
  2484.   FSFXModule := '7z.sfx';
  2485.  
  2486. // Shadow 28.11.2006
  2487.   FCreateObject := nil;
  2488.  
  2489. {$IFDEF UseRes7zdll}
  2490.     MemoryStream := TResourceStream.Create( HInstance, sZipLibDLL, RT_RCDATA );
  2491.     try
  2492.       m_DllDataSize := MemoryStream.Size;
  2493.       mp_DllData := GetMemory( m_DllDataSize );
  2494.       MemoryStream.Read( mp_DllData^, m_DllDataSize );
  2495.     finally
  2496.       MemoryStream.Free;
  2497.     end;
  2498.  
  2499.     mp_MemoryModule := BTMemoryLoadLibary( mp_DllData, m_DllDataSize );
  2500.     @FCreateObject := BTMemoryGetProcAddress( mp_MemoryModule, 'CreateObject' );
  2501. {$ELSE}                                                        //FHO 25.01.2007
  2502.   F7zaLibh := LoadLibrary( '7za.dll' );
  2503.   if F7zaLibh <> 0 then                                        //FHO 25.01.2007
  2504.     @FCreateObject := GetProcAddress( F7zaLibh, 'CreateObject' );
  2505. {$ENDIF}
  2506.  
  2507.   if not Assigned( FCreateObject ) then begin
  2508.     raise Exception.Create( 'Could not load CreateObject function from 7za.dll' + #13#10 + 'Perhaps 7za.dll not found' );
  2509.   end else begin
  2510.     FCreateObject( @CLSID_CFormat7z, @IID_IInArchive, inA );
  2511.     FCreateObject( @CLSID_CFormat7z, @IID_IOutArchive, outA );
  2512.     FCreateObject( @CLSID_CFormat7z, @IID_ISetProperties, sp );
  2513.   end;
  2514.  
  2515.   OSVerInfo.dwOSVersionInfoSize := sizeof(OSVerInfo);
  2516.   GetVersionEx(OsVerInfo);
  2517.   if osverinfo.dwPlatformID = VER_PLATFORM_WIN32_WINDOWS then
  2518.    isUnicode := false else
  2519.    isUnicode := true;
  2520. end;
  2521.  
  2522. destructor TSevenzip.Destroy;
  2523. begin
  2524.   ClearNamesOfVolumeWritten;
  2525.  
  2526. //jjw 18.10.2006
  2527.   inA := nil;
  2528.   outA := nil;
  2529.   sp := nil;
  2530.  
  2531. {$IFDEF UseRes7zdll}
  2532.   if m_DllDataSize > 0 then FreeMemory( mp_DllData );
  2533.   if mp_MemoryModule <> nil then BTMemoryFreeLibrary( mp_MemoryModule );
  2534. {$ELSE}                                                        //FHO 25.01.2007
  2535.   if F7zaLibh > 0 then FreeLibrary( F7zaLibh );
  2536. {$ENDIF}
  2537.  
  2538.   ffiles.Clear;
  2539.   ffiles.Free;
  2540.  
  2541.   inherited;
  2542. end;
  2543. //------------------------------------------------------------------------------------------------
  2544. //End constructor destructor
  2545. //------------------------------------------------------------------------------------------------
  2546.  
  2547. Procedure TSevenZip.Cancel; // public
  2548. begin
  2549.  FMainCancel := True;
  2550. end;
  2551.  
  2552. Procedure TSevenZip.ResetCancel; // private
  2553. begin
  2554.  FMainCancel := False;
  2555. end;
  2556. //RG 02.06.2006
  2557.  
  2558. (*
  2559. function TSevenZip.GetIndexByFilename( FileToExtract: Widestring ): Integer;
  2560. var
  2561.   n: Integer;
  2562.   w: DWORD;
  2563.   fnameprop: PROPVARIANT;
  2564.   fileInArchive: widestring;
  2565.   ms: TMyStreamReader;
  2566. begin
  2567.   try
  2568.     Result := -1;
  2569.     ms := TMyStreamReader.Create( Self, FSevenZipFileName, TRUE );
  2570.     inA.Close;
  2571.     inA.Open( ms, nil, nil );
  2572.     inA.GetNumberOfItems( w ); //1..end
  2573.     FileToExtract := UppercaseW_( FileToExtract );
  2574.     for n := 0 to w-1 do begin
  2575.       fnameprop.vt := VT_EMPTY;
  2576.       inA.GetProperty( n, kpidPath, fnameprop );
  2577.       fileInArchive := UppercaseW_( OleStrToString( fnameprop.bstrVal ) );
  2578.       if ( fileInArchive = FileToExtract ) then begin
  2579.         Result := n;
  2580.         Break;
  2581.       end;
  2582.     end;
  2583.   finally
  2584.     inA.close;
  2585.   end
  2586. end;
  2587. *)
  2588.  
  2589. // ZSA 21.02.2006 -- By splitting GetIndexByFilename into two parts allow
  2590. //  the Extract function to translate filenames into indices correctly
  2591. //  without closing 'inA'
  2592. function TSevenZip.InternalGetIndexByFilename( FileToExtract: Widestring ): Integer;
  2593. var
  2594.   n: Integer;
  2595.   w: DWORD;
  2596.   fnameprop: PROPVARIANT;
  2597.   fileInArchive: widestring;
  2598. begin
  2599.   Result := -1;
  2600.   inA.GetNumberOfItems( w ); //1..end
  2601.   FileToExtract := UppercaseW_( FileToExtract );
  2602.   for n := 0 to w-1 do begin
  2603.     fnameprop.vt := VT_EMPTY;
  2604.     inA.GetProperty( n, kpidPath, fnameprop );
  2605.     fileInArchive := UppercaseW_( OleStrToString( fnameprop.bstrVal ) );
  2606.     if ( fileInArchive = FileToExtract ) then begin
  2607.       Result := n;
  2608.       Break;
  2609.     end;
  2610.   end;
  2611. end;
  2612.  
  2613. function TSevenZip.GetIndexByFilename( FileToExtract: Widestring ): Integer;
  2614. var
  2615.   ms: TMyStreamReader;
  2616. begin
  2617.   try
  2618.     Result := -1;
  2619.     ms := TMyStreamReader.Create( Self, FSevenZipFileName, TRUE );
  2620.     inA.Close;
  2621.     inA.Open( ms, nil, nil );
  2622.     Result := InternalGetIndexByFilename( FileToExtract );
  2623.   finally
  2624.     inA.close;
  2625.   end
  2626. end;
  2627.  
  2628.  
  2629. //-------------------------------------------------------
  2630. //SFX functions
  2631. // Shadow 28.11.2006
  2632. function TSevenZip.SFXCheck( Fn: WideString ): Boolean;
  2633. const
  2634.   ID_7z: Array[ 0..5 ] of byte = ( 55, 122, 188, 175, 39, 28 );
  2635. var
  2636.   MySize, MyOrigSize: DWORD;
  2637.   Source: Integer;
  2638.   Buffer: array[ 0..81919 ] of Byte;
  2639.   ReadBytes, i: DWORD;
  2640.  
  2641.   function MyOriginalSize: DWORD;
  2642.   var
  2643.     s, d: DWORD;
  2644.     w: Word;
  2645.   begin
  2646.     Result := 0;
  2647.     s := FileSeek( Source, 0, soFromCurrent );
  2648.     try
  2649.       FileSeek( Source, $3C, soFromBeginning );
  2650.       FileRead( Source, d, 4 );
  2651.       FileSeek( Source, d + $06, soFromBeginning );
  2652.       FileRead( Source, w, 2 );
  2653. {?????????????}
  2654.       Inc( w );
  2655. {?????????????}
  2656.       FileSeek( Source, ( d + $F8 ) + ( w * $28 ) - $14 , soFromBeginning );
  2657.       FileRead( Source, Result, 4 );
  2658.     finally
  2659.       FileSeek( Source, s, soFromBeginning );
  2660.     end;
  2661.   end;
  2662.  
  2663.   function CheckSignature( Offset: Integer ): Boolean;
  2664.   var
  2665.     i: Integer;
  2666.   begin
  2667.     Result := FALSE;
  2668.     for i := 0 to 5 do begin
  2669.       if ( Buffer[ Offset + i ] <> ID_7z[ i ] ) then Break;
  2670.       if i = 5 then Result := TRUE;
  2671.     end;
  2672.   end;
  2673.  
  2674. begin
  2675.   Result := FALSE;
  2676.   if UpperCaseW_( ExtractFileExtW( Fn ) ) <> '.EXE' then Exit;
  2677.  
  2678.   FSFXoffset := 0;
  2679.   FIsSFX := FALSE;
  2680.  
  2681.   Source := CreateFile_( PWideChar( Fn ), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0 );
  2682.   try
  2683.     MySize := FileSeek( Source, int64(0), soFromEnd );
  2684.     FileSeek( Source, 65536, soFromBeginning );
  2685.     ReadFile( Source, Buffer[ 0 ], SizeOf( Buffer ), ReadBytes, nil );
  2686.     for i := 0 to ReadBytes - 6 do begin
  2687.       FIsSFX := CheckSignature( i );
  2688.       if FIsSFX then begin
  2689.         FSFXOffset := 65536 + i;
  2690.         Result := TRUE;
  2691.         Break;
  2692.       end;
  2693.     end;
  2694.     if not FIsSFX then begin
  2695.       MyOrigSize := MyOriginalSize;
  2696.       if MySize <> MyOrigSize then begin
  2697.         FileSeek( Source, int64(MyOrigSize), soFromBeginning );
  2698.         ReadFile( Source, Buffer[ 0 ], 6, ReadBytes, nil );
  2699.         FIsSFX := CheckSignature( 0 );
  2700.         if FIsSFX then begin
  2701.           FSFXOffset := MyOrigSize;
  2702.           Result := TRUE;
  2703.         end;
  2704.       end;
  2705.     end;
  2706.   finally
  2707.     FileClose( Source );
  2708.   end;
  2709. end;
  2710.  
  2711. function TSevenZip.ConvertSFXto7z( Fn:Widestring ): boolean;
  2712. var Source,Dest: Integer;
  2713.     DestFn: Widestring;
  2714.     buffer: pointer;
  2715.     readbytes,writebytes:Dword;
  2716. const
  2717.     chunksize = 1024*128;
  2718. begin
  2719.   //ErikGG Begin 08.11.06
  2720.   Buffer := Nil;
  2721.   Source := -1;
  2722.   Dest := -1;
  2723.   Result := False;
  2724.   //ErikGG End 08.11.06
  2725.   try
  2726.     DestFn := changefileextW( Fn,'.7z' );
  2727.      Source := CreateFile_( PwideChar( Fn ), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0 );
  2728.     Fileseek( Source,SFXoffset,0 ); //goto 7z data
  2729.     Dest := CreateFile_( PwideChar( DestFn ), GENERIC_WRITE, 0, nil, CREATE_ALWAYS, 0, 0 );
  2730.  
  2731.     GetMem( Buffer,chunksize ); { allocate the buffer }
  2732.  
  2733.     repeat
  2734.       readbytes := Fileread( Source,buffer^,chunksize );
  2735.       writebytes := Filewrite( Dest,buffer^,readbytes );
  2736.     until readbytes < chunksize;
  2737.  
  2738.     if writebytes <> readbytes then
  2739.         Result := false
  2740.     else
  2741.         Result := true;//Only reached if no error happend
  2742.  
  2743.     //ErikGG 08.11.06
  2744.     Result := true;//Only reached if no error happend
  2745.   finally
  2746.     //ErikGG Begin 07.11.06
  2747.     if Buffer <> Nil then freemem( buffer );
  2748.     if Source <> 0 then   Fileclose( Source );
  2749.     if Dest <> 0 then     Fileclose( Dest );
  2750.     //ErikGG End 07.11.06
  2751.   end;
  2752.  
  2753. end;
  2754.  
  2755. function TSevenZip.Convert7ztoSFX( Fn:Widestring ): boolean;
  2756. var Source,Dest: Integer;
  2757.     DestFn: Widestring;
  2758.     buffer: pointer;
  2759.     readbytes,writebytes:Dword;
  2760. const
  2761.     chunksize = 1024*128;
  2762. begin
  2763.  //ErikGG Begin 07.11.06
  2764.  Result := false;
  2765.  Buffer := Nil;
  2766.  Source := -1;
  2767.  Dest := -1;
  2768.  //ErikGG End 07.11.06
  2769.  
  2770.  DestFn := changefileextW( Fn,'.exe' );
  2771.  if not copyfilew( PWidechar( sfxmodule ),PWideChar( DestFn ),True ) then
  2772.   begin
  2773.    FLastError:=GetLastError;                                   //FHO 22.01.2007
  2774.    ErrCode:=FSFXModuleError;
  2775.    if assigned( onMessage ) then
  2776.      onMessage( self,FSFXModuleError, c7zipResMsg[FSFXModuleError], Fsevenzipfilename );
  2777.    exit;
  2778.   end;
  2779.  
  2780. try
  2781.   Source := CreateFile_( PwideChar( Fn ), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0 );
  2782.   Dest := CreateFile_( PwideChar( DestFn ), GENERIC_Write, 0, nil, OPEN_EXISTING, 0, 0 );
  2783.   fileseek( Dest,0,2 );
  2784.  
  2785.   GetMem( Buffer,chunksize ); { allocate the buffer }
  2786.  
  2787.   repeat
  2788.     readbytes := Fileread( Source,buffer^,chunksize );
  2789.     writebytes := Filewrite( Dest,buffer^,readbytes );
  2790.   until readbytes < chunksize;
  2791.  
  2792.    if writebytes <> readbytes then
  2793.       Result := false
  2794.    else
  2795.       Result := true;//Only reached if no error happend
  2796. finally
  2797.  
  2798.  if Buffer <> Nil then freemem( buffer );
  2799.  if Source <> 0 then   Fileclose( Source );
  2800.  if Dest <> 0 then     Fileclose( Dest );
  2801.  //ErikGG End 07.11.06
  2802. end;
  2803.  
  2804. end;
  2805.  
  2806.  
  2807. //SFX functions end
  2808. //-------------------------------------------------------
  2809.  
  2810. function TSevenZip.List: Integer;
  2811. var
  2812.   ms: TMyStreamReader;
  2813.   updateOpenCallback: TmyArchiveOpenCallback;
  2814.   i: Integer;
  2815.   w: DWord;
  2816.   name: TBSTR;
  2817.   prop: PROPID;
  2818.   pType: Integer;
  2819.   path: PROPVARIANT;
  2820.   size: PROPVARIANT;
  2821.   packedsize: PROPVARIANT;
  2822.   attr:PROPVARIANT;
  2823.   fcrc: PROPVARIANT;
  2824.   szMethod: PROPVARIANT;
  2825.   sztime: PROPVARIANT;
  2826.   szMethod_WS: Widestring;
  2827.   blockpid: PROPVARIANT;
  2828. begin
  2829.   try
  2830.     Ffiles.Clear;
  2831.  
  2832.     FNumberOfFiles := -1;
  2833.     if UppercaseW_( ExtractFileExtW( FSevenZipFileName ) ) = '.EXE' then begin
  2834.       if not SFXCheck( FSevenZipFileName ) then begin
  2835.         Result := -1;
  2836.         ErrCode:=FNoSFXarchive;                                //FHO 21.01.2007
  2837.         if assigned( onMessage ) then
  2838.           onMessage( self, FNoSFXarchive, c7zipResMsg[FNoSFXarchive], Fsevenzipfilename );
  2839.         Exit;
  2840.       end;
  2841.     end;
  2842.  
  2843.     ms := TMyStreamReader.Create( Self, FSevenZipFileName, TRUE );
  2844.     inA.Close;
  2845.  
  2846. // 24.08.06 - Matteo Riso - Status: experimental
  2847. // 25.08.06 Modified by rg
  2848. //
  2849. // If we loaded an .EXE file, we could start reading from offset 132096.
  2850. // Also supported by newerdll
  2851.  
  2852. //  if FIsSFX then ms.Seek( FSFXOffset,0,@FSFXOffset );
  2853.  
  2854. // End - MR modification
  2855.  
  2856.     updateOpenCallback := TMyArchiveOpenCallback.Create( self );
  2857.     i := inA.Open(ms, nil,updateOpencallback );
  2858.  
  2859.   if i <> 0 then
  2860.    begin
  2861.      Result := -1;
  2862.      ErrCode:=FFileNotFound;                                   //FHO 21.01.2007
  2863.      if assigned( onMessage ) then
  2864.        onMessage( self, FFileNotFound, c7zipResMsg[FFileNotFound], Fsevenzipfilename );
  2865.      Exit;
  2866.    end;
  2867.  
  2868. (*
  2869.    inA.GetNumberOfArchiveProperties( w );
  2870.    for i := 0 to w-1 do
  2871.     begin
  2872.      path.vt := VT_EMPTY;
  2873.      ina.GetArchiveProperty( kpidPath,@path );
  2874.      if assigned( onMessage ) then onMessage( self,i,path.bstrVal,path.pwszVal );
  2875.     end;
  2876. *)
  2877.  
  2878.   inA.GetNumberOfProperties( w );
  2879.  
  2880.   for i := 0 to w - 1 do
  2881.   begin
  2882.     name := new( TBSTR );
  2883.     ptype := 0;
  2884.     inA.GetPropertyInfo( i, name, prop, pType );
  2885.     //Dispose(name);
  2886. {$IFDEF UseLog}
  2887.     if name = nil then
  2888.     begin
  2889.       Log( Format( '%d %s %s ( %d ) %s ( %d )', [ i, '', PropIDToString( prop ), prop, PropTypeToString( pType ), pType ] ) )
  2890.     end else
  2891.     begin
  2892.       log( Format( '%d %s %s ( %d ) %s ( %d )', [ i, name, PropIDToString( prop ), prop, PropTypeToString( pType ), pType ] ) );
  2893.     end;
  2894. {$ENDIF}
  2895.   end;
  2896.  
  2897.  
  2898.   inA.GetNumberOfItems( w );
  2899.   FNumberOfFiles := w;
  2900.  
  2901.   for i := 0 to w-1 do
  2902.    begin
  2903.        path.vt := VT_EMPTY;
  2904.        size.vt := VT_EMPTY;
  2905.        packedsize.vt := VT_EMPTY;
  2906.        attr.vt := VT_EMPTY;
  2907.        fcrc.vt := VT_EMPTY;
  2908.        szmethod.vt := VT_EMPTY;
  2909.        sztime.vt := VT_EMPTY;
  2910.        blockpid.vt := VT_EMPTY;
  2911.  
  2912.        inA.GetProperty( i, kpidPath, path );
  2913.        inA.GetProperty( i, kpidSize, size );
  2914.        inA.GetProperty( i, kpidPackedSize, packedsize );
  2915.        inA.GetProperty( i, kpidAttributes, attr );
  2916.        inA.GetProperty( i, kpidCRC, fcrc );
  2917.        inA.GetProperty( i, kpidMethod, szMethod );
  2918.        inA.GetProperty( i, kpidLastWriteTime, sztime );
  2919.        inA.GetProperty( i, kpidblock, blockpid );
  2920.  
  2921.        try
  2922.        if ( ( ( attr.uiVal and ( 1 shl 4 ) ) <> 0 ) or ( size.uhVal.QuadPart = 0 ) ) then szMethod_WS := 'None'  // is a directory or 0byte file
  2923.         else  //rg 18.04.06
  2924.          szMethod_WS := Widestring( szmethod.bstrVal ); //Check for diectoies or 0 byte files, if not an exception happens
  2925.  
  2926.        //ErikGG Begin 07.11.06
  2927.        //Add all found files and directories to the Files List
  2928.        //Is it a directory then add only paths with the backslash
  2929.        if ( ( attr.uiVal and ( 1 shl 4 ) ) <> 0 ) then
  2930.         ffiles.AddString( Widestring( AppendSlash( path.bstrVal ) ) )
  2931.        else
  2932.         ffiles.AddString( Widestring( path.bstrVal ) );
  2933.        //ErikGG End 07.11.06
  2934.  
  2935.        if assigned( Fonlistfile ) then
  2936.           Fonlistfile( self,
  2937.             Widestring( path.bstrVal ),  //filename 1
  2938.             i,                         //fileindex for extracting
  2939.             size.uhVal.QuadPart,       //Filesizeunp  2
  2940.             packedsize.uhVal.QuadPart, //FilesizeP 3
  2941.             ( attr.uhVal.QuadPart and not ( 1 shl 13 ) ), //attr 4 , removes first set bit
  2942.             fcrc.uhVal.QuadPart,       //CRC 5
  2943.             szMethod_WS,               //method 6
  2944.             FileTimeToDateTime( sztime.filetime,2 )  //filetime 7
  2945.             );
  2946.        except
  2947.        end;
  2948.    end; //for i:= 0
  2949.  
  2950.    Result := FNumberOfFiles;
  2951.  
  2952.  
  2953. finally
  2954.    ina.Close;
  2955.    ResetCancel;
  2956. end;
  2957.  
  2958. end;
  2959.  
  2960. /////// Added MK 30.03.2006
  2961. // ErikGG 07.11.06 Rewrote the add method,
  2962.  
  2963. function TSevenZip.Add: Integer;
  2964. var
  2965.   updateCallback: TMyArchiveUpdateCallback;
  2966.   intf: IArchiveUpdateCallback;
  2967.   MyStreamWriter:TMyStreamWriter;
  2968.   outStream: IOutStream;
  2969.   i,FileAttr{, FtoAdd, fHnd}: Integer;
  2970.   a: Int64; // Bug GDG 21.02.07
  2971.   FMaxProgress:int64;
  2972.   FileDT:TFiletime;
  2973.   FileSize_:int64;
  2974.   setProperties: ISetProperties;
  2975.   SetP: array[ 0..10 ] of PROPVARIANT;
  2976.   SetPNames: array[ 0..2 ] of PWideChar;
  2977.   FilesinBuffer, CurrBuffSize, NumOfProps: Cardinal;
  2978.  
  2979. //Get compression strength for adding
  2980.   function SevenZipCompressionStrengthInt( cs: TCompressStrength ): Cardinal;
  2981.   begin
  2982.     case cs of
  2983.       SAVE: result := 0;
  2984.       FAST: result := 3;
  2985.       NORMAL: result := 5;
  2986.       MAXIMUM: result := 7;
  2987.       ULTRA: result := 9;
  2988.     else
  2989.       result := 5;
  2990.     end;
  2991.   end;
  2992.  
  2993. // Shadow 28.11.2006
  2994. //Get directory content and recursive if wanted
  2995. //------------------------------------------------------------------------------
  2996.   procedure AddFile( _Name: WideString; _Size: Int64; _DateTime: _FILETIME; _Attr: Cardinal );
  2997.   begin
  2998.     if CurrBuffSize <= FilesinBuffer then begin //Increase the Buffers by 100 entries.
  2999.       Inc( CurrBuffSize, 100 );
  3000.       Setlength( updateCallback.Files, CurrBuffSize );
  3001.       Setlength( updateCallback.Files_size, CurrBuffSize );
  3002.       Setlength( updateCallback.Files_Date, CurrBuffSize );
  3003.       Setlength( updateCallback.Files_Attr, CurrBuffSize );
  3004.     end;
  3005.  
  3006.     updateCallback.Files[ FilesinBuffer ] := _Name;
  3007.     updateCallback.Files_size[ FilesinBuffer ] := _Size;
  3008.     updateCallback.Files_Date[ FilesinBuffer ] := _DateTime;
  3009.     updateCallback.Files_Attr[ FilesinBuffer ] := _Attr;
  3010.  
  3011.     FMaxProgress := FMaxProgress + _Size;
  3012.     Inc( FilesinBuffer );
  3013.   end;
  3014.  
  3015.   procedure AddRootDir( const Dir: WideString );
  3016.   var
  3017.     s: WideString;
  3018. //    l: Integer;
  3019.   begin
  3020.     s := ClearSlash( Dir );
  3021.     if not DirectoryExistsW( s ) then Exit;
  3022.     GetFileSizeandDateTime_Int64( s, FileSize_, FileDT, FileAttr );
  3023. //    l := Length( s );
  3024.     if (Frootdir <> '') then                 //rg remove path infront of directory 6.2.2007
  3025.       delete(s,1,length(Frootdir))
  3026.      else
  3027.       delete(s,1,3);
  3028.  
  3029. //    while ( l > 0 ) and ( s[ l ] <> '\' ) do Dec( l );
  3030. //    s := Copy( s, l + 1, MaxInt );
  3031.  
  3032.     if s <> '' then AddFile( s, FileSize_, FileDT, FileAttr );
  3033.   end;
  3034.  
  3035.   procedure GetDirs( Const MainDir, Ext: WideString );
  3036.   var
  3037.     srw: _Win32_Find_Dataw;
  3038.     SearchHandle: Cardinal;
  3039.   begin
  3040.     srw.dwFileAttributes := faAnyFile;
  3041.     SearchHandle := FindFirstFileW( PWideChar( MainDir + '*.*' ), srw );
  3042.     if SearchHandle <> INVALID_HANDLE_VALUE then begin
  3043.       repeat
  3044.         if ( srw.cFileName = Widestring('.') ) then Continue; //Blocks "." and ".." filenames
  3045.         if ( srw.cFileName = Widestring('..') ) then Continue; //Blocks "." and ".." filenames
  3046.  
  3047.         if ( ( srw.dwFileAttributes and faDirectory ) = faDirectory ) then
  3048.          begin//Is a Directory
  3049.           if not ( AddStoreOnlyFilename in FAddOptions ) then
  3050.            Addfile(
  3051.              MainDir + srw.cFileName,
  3052.              srw.nFileSizeHigh shl 32 + srw.nFileSizeLow,
  3053.              srw.ftLastWriteTime,
  3054.              srw.dwFileAttributes
  3055.            );
  3056.  
  3057.           if ( AddRecurseDirs in FAddoptions ) then GetDirs( AppendSlash( MainDir + srw.cFileName ), Ext );
  3058.          end
  3059.         else
  3060.          begin //Is a file
  3061.           if ( Ext <> '.*' ) and ( ExtractFileExtW( srw.cFileName ) <> Ext ) then Continue;
  3062.           Addfile(
  3063.             MainDir + srw.cFileName,
  3064.             srw.nFileSizeHigh shl 32 + srw.nFileSizeLow,
  3065.             srw.ftLastWriteTime,
  3066.             srw.dwFileAttributes
  3067.           );
  3068.          end;
  3069.       until not FindNextFileW( SearchHandle, srw ) or FMainCancel;
  3070.       Windows.FindClose( SearchHandle );
  3071.     end;
  3072.   end;
  3073. {
  3074.      procedure SetPassword( Password: String );
  3075.      var
  3076.        CryptoSetPassword: ICryptoSetPassword;
  3077.        Buffer: PChar;
  3078.        SizeInBytes: DWORD;
  3079.        i: Integer;
  3080.      begin
  3081.        if not Assigned( SetPwd ) then Exit;
  3082.        if SetPwd.QueryInterface( IID_ICryptoSetPassword, CryptoSetPassword ) = S_OK then begin
  3083.          SizeInBytes := Length( Password ) * 2;
  3084.          GetMem( Buffer, SizeInBytes );
  3085.          try
  3086.            for i := 0 to Length( Password ) - 1 do begin
  3087.              Buffer[ i * 2 ] := Password[ i + 1 ];
  3088.              Buffer[ i * 2 + 1 ] := #0;
  3089.            end;
  3090.            CryptoSetPassword.CryptoSetPassword( Buffer, SizeInBytes );
  3091.           finally
  3092.            FreeMem( Buffer );
  3093.          end;
  3094.         end;
  3095.      end;
  3096. }
  3097. begin //main procedure
  3098.   try
  3099.     ResetCancel; // Modified TM - 30/8/2007
  3100.     updateCallback := TMyArchiveUpdateCallback.Create( self );
  3101.  
  3102. // Set FRootDir to uppercase for comparing
  3103. // Set AddRootdir for relative path or wholepath
  3104. // Set Frootdir to '' to add whole path
  3105.  
  3106.     FRootDir := UppercaseW_( FRootDir );
  3107.     updateCallback.RootDir := AppendSlash( FRootDir );
  3108.  
  3109.     FMaxProgress := 0;
  3110.     FilesinBuffer := 0;
  3111.     CurrBuffSize := 0;
  3112.  
  3113.     for i := 0 to Ffiles.Count- 1 do begin
  3114. //Contains a directory in the sence of C:\DIR\*.*
  3115.       a := Pos( '*', Ffiles.WStrings[ i ] );
  3116.       if a > 0 then begin
  3117.         AddRootDir( AppendSlash( Copy( Ffiles.WStrings[ i ], 1, a-1 ) ) ); //fehler
  3118.         GetDirs( AppendSlash( Copy( Ffiles.WStrings[ i ], 1, a-1 ) ), Copy( ffiles.WStrings[ i ], a + 1, 8 ) );
  3119.       end else begin
  3120.        a := GetFileSizeandDateTime_Int64( Ffiles.Wstrings[ i ],FileSize_, FileDT, FileAttr );       //rg2.2.2007
  3121.        if a >= 0 then
  3122.         AddFile( Ffiles.Wstrings[ i ], FileSize_, FileDT, FileAttr );
  3123.       end;
  3124.     end;
  3125.  
  3126. //Reset the Buffers back to the size equaling the number of files.
  3127.     SetLength( updateCallback.Files, FilesinBuffer );
  3128.     SetLength( updateCallback.Files_size, FilesinBuffer );
  3129.     SetLength( updateCallback.Files_Date, FilesinBuffer );
  3130.     SetLength( updateCallback.Files_Attr, FilesinBuffer );
  3131.  
  3132. //send MaxProgress to App
  3133.    if Assigned( OnPreProgress ) then OnPreProgress( Self, FMaxProgress );
  3134.  
  3135.    MyStreamWriter := nil;
  3136.  
  3137.   if ( FSFXCreate ) and ( FileExists_( FSFXModule ) ) then begin
  3138.     FSevenZipFileName := ChangeFileExtW( FSevenZipFileName,'.exe' );
  3139.     if CopyFileW( PWidechar( SFXModule ), PWideChar( FSevenZipFileName ), True ) then
  3140. // Shadow 27.11.2006                                           //FHO 17.01.2007
  3141.      MyStreamWriter := TMyStreamWriter.Create(@fLastError,     //FHO 22.01.2007
  3142.                             FSevenZipFileName, Now, FILE_ATTRIBUTE_ARCHIVE, FVolumeSize, TRUE )
  3143.     else begin
  3144.        FLastError:=GetLastError;                               //FHO 22.01.2007
  3145.        ErrCode:=FSXFileCreationError ;
  3146.        if Assigned( onMessage ) then
  3147.         OnMessage( self, FSXFileCreationError , c7zipResMsg[FSXFileCreationError], FSevenZipFileName);
  3148.      end;
  3149.    end else                                                    //FHO 17.01.2007
  3150.      MyStreamWriter := TMyStreamWriter.Create( @fLastError, FSevenZipFileName, now, FILE_ATTRIBUTE_ARCHIVE, FVolumeSize, false );
  3151.  
  3152.    outStream:=MyStreamWriter;                                  //FHO 17.01.2007
  3153.  
  3154.   //_______________
  3155.   //Setp.vt := VT_EMPTY;
  3156.   //Set archive options
  3157.   if outA.QueryInterface( IID_ISetProperties, setProperties ) = S_OK then begin
  3158.     NumOfProps := 0;
  3159.     //rg 17.04.06
  3160.     case FCompressType of
  3161.      LZMA: begin
  3162.             // 7z Profile
  3163.             Setp[ NumOfProps ].vt := VT_UI4;
  3164.             SetPNames[ NumOfProps ] := StringToOleStr( 'X' );
  3165.             Setp[ NumOfProps ].ulVal := SevenZipCompressionStrengthInt( FCompstrength );
  3166.             inc( NumOfProps );
  3167.  
  3168.             //Solid
  3169.             Setp[ NumOfProps ].vt := VT_BSTR;
  3170.             SetPNames[ NumOfProps ] := StringToOleStr( 's' );
  3171.             if ( AddSolid in FAddoptions ) then
  3172.              Setp[ NumOfProps ].bstrVal := SysAllocString( 'on' )
  3173.             else
  3174.              Setp[ NumOfProps ].bstrVal := SysAllocString( 'off' );
  3175.  
  3176.             inc( NumOfProps );
  3177.  
  3178.  
  3179.             {
  3180.             directorysize 0..27
  3181.             No need to set if you use CompressionStrength Profiles
  3182.             ( Save...Ultra )
  3183.             }
  3184.             if FLZMAStrength > 0 then
  3185.              begin
  3186.               Setp[ NumOfProps ].vt := VT_UI4;
  3187.               SetPNames[ NumOfProps ] := StringToOleStr( 'd' );
  3188.               Setp[ NumOfProps ].ulVal := FLZMAStrength;
  3189.               inc( NumOfProps )
  3190.              end;
  3191.           end;
  3192.      PPMD: begin
  3193.             // PPMD compression
  3194.             Setp[ NumOfProps ].vt := VT_BSTR;
  3195.             SetPNames[ NumOfProps ] := StringToOleStr( '0' );
  3196.             Setp[ NumOfProps ].bstrVal := SysAllocString( 'PPMd' );
  3197.             inc( NumOfProps );
  3198.  
  3199.             //PPMD Size
  3200.             //No need to set if you use defaults
  3201.             if FPPMDsize > 0 then
  3202.              begin
  3203.               Setp[ NumOfProps ].vt := VT_UI4;
  3204.               SetPNames[ NumOfProps ] := StringToOleStr( 'o' );
  3205.               Setp[ NumOfProps ].ulVal := 10;
  3206.               inc( NumOfProps );
  3207.              end;
  3208.  
  3209.             //PPMD Mem
  3210.             //No need to set if you use defaults
  3211.             if FPPMDmem > 0 then
  3212.              begin
  3213.               Setp[ NumOfProps ].vt := VT_UI4;
  3214.               SetPNames[ NumOfProps ] := StringToOleStr( 'mem' );
  3215.               Setp[ NumOfProps ].ulVal := 30;
  3216.               inc( NumOfProps );
  3217.              end;
  3218.            end;
  3219.     end; //end case
  3220.  
  3221.     if (FPassword <> '') and ( AddEnCryptFilename in FAddoptions ) then
  3222.       begin  
  3223.         Setp[ NumOfProps ].vt := VT_BSTR;
  3224.         SetPNames[ NumOfProps ] := StringToOleStr( 'he' );
  3225.         Setp[ NumOfProps ].bstrVal := SysAllocString( 'on' );
  3226.         inc( NumOfProps );
  3227.       end;
  3228.    
  3229.     // set options
  3230.     result := setProperties.SetProperties( @SetPNames, @Setp, NumOfProps );
  3231.    end; //if QuerryInterface
  3232.   //____________________
  3233.  
  3234.  
  3235.   if FilesinBuffer > 0 then Begin
  3236.     intf := updateCallback;
  3237.     Result := outA.UpdateItems( outStream, FilesinBuffer, updateCallback );
  3238.   end else begin
  3239.     ErrCode:=FNoFilesToAdd;                                    //FHO 21.01.2007
  3240.     if Assigned( OnMessage ) then
  3241.       OnMessage( Self, FNoFilesToAdd, c7zipResMsg[FNoFilesToAdd], '' );
  3242.     Result := -1;
  3243.   end;
  3244.  
  3245.   ClearNamesOfVolumeWritten;                                   //FHO 17.01.2007
  3246.  
  3247.   With MyStreamWriter do begin                                 //FHO 17.01.2007
  3248.     SetLength(FNamesOfVolumesWritten,Length(Files));           //FHO 17.01.2007
  3249.     for i:= 0 to Length(FNamesOfVolumesWritten)-1 do           //FHO 17.01.2007
  3250.       FNamesOfVolumesWritten[i]:=Files[i].Name;                //FHO 17.01.2007
  3251.   end;
  3252. //  MyStreamWriter:=NIL;                                         //FHO 17.01.2007
  3253.  
  3254.   if OutStream <> nil then
  3255.   begin
  3256.    OutStream := nil;
  3257.   end;
  3258.  
  3259.  finally
  3260.   ResetCancel;
  3261.  end;
  3262. end;
  3263.  
  3264.  
  3265. function TSevenZip.Extract( TestArchive:Boolean=False ): Integer;
  3266. var
  3267.   updateCallback: TMyArchiveExtractCallback;
  3268.   updateOpenCallback: TmyArchiveOpenCallback;
  3269.   ms: TMyStreamReader;
  3270.   filesDW: array of DWORD;
  3271.   Filestoex,w: DWORD;
  3272.   i,j,n: Integer;
  3273.   FMaxProgress:int64;
  3274.   size: PROPVARIANT;
  3275. //  fnameprop: PROPVARIANT;
  3276. //  fileInArchive, fileToExtract: WideString;
  3277.  
  3278. begin
  3279. try
  3280. // 24.08.06 - Matteo Riso - Status: experimental
  3281. // 25.08.06 Modified by rg
  3282. //
  3283. // If we loaded an .EXE file, we could start reading from offset 132096.
  3284. // Also supported by newerdll
  3285.  
  3286. //  if FIsSFX then ms.Seek( FSFXOffset,0,@FSFXOffset );
  3287.  
  3288. // End - MR modification
  3289.  
  3290. // Shadow 28.11.2006
  3291.     if UppercaseW_( ExtractFileExtW( FSevenZipFileName ) ) = '.EXE' then begin
  3292.       if not SFXCheck( FSevenZipFileName ) then begin
  3293.         Result := -1;
  3294.         ErrCode:=FNoSFXarchive;                                //FHO 21.01.2007
  3295.         if assigned( onMessage ) then
  3296.           onMessage( self, FNoSFXarchive, c7zipResMsg[FNoSFXarchive], Fsevenzipfilename );
  3297.         Exit;
  3298.       end;
  3299.     end;
  3300.  
  3301.     ms := TMyStreamReader.Create( Self, FSevenZipFileName, TRUE );
  3302.     inA.Close;
  3303.  
  3304.     updateOpenCallback := TMyArchiveOpenCallback.Create( self );
  3305.     i := inA.Open( ms, nil, updateOpenCallback );
  3306.  
  3307.     if i <> 0 then begin
  3308.       Result := -1;
  3309.       ErrCode:=FFileNotFound;                                  //FHO 21.01.2007
  3310.       if assigned( onMessage ) then
  3311.         onMessage( self,FFileNotFound, c7zipResMsg[FFileNotFound],FSevenZipFileName );
  3312.       ms.Free;                                                //FHO crash at wrong pw 25.01.2007
  3313.       Exit;
  3314.     end;
  3315.  
  3316.     FMaxProgress := 0;
  3317.     inA.GetNumberOfItems( w ); //1..end
  3318.     dec( w ); //Starting with 0..end-1
  3319.  
  3320.     n := 0;
  3321.     if FFiles.Count > 0 then begin
  3322.       SetLength( filesDW, ffiles.Count );
  3323.       for i := 0 to FFiles.count - 1 do begin
  3324.         if not TryStrToInt_( Ffiles.WStrings[ i ], j ) then
  3325. //          j := InternalGetIndexByFilename( Ffiles.WStrings[ i ] );    //ZSA 21.02.2007
  3326.           j := GetINdexbyFilename( Ffiles.WStrings[ i ] );
  3327.  
  3328.           if (j < 0) or (abs(j) > abs(w)) then begin
  3329.             ErrCode:=FIndexOutOfRange;                         //FHO 21.01.2007
  3330.             if Assigned( onMessage ) then
  3331.               onMessage( Self, FIndexOutOfRange, c7zipResMsg[FIndexOutOfRange], '' );
  3332.             Result := -1;
  3333.             Exit;
  3334.           end;
  3335.  
  3336.           size.vt := VT_EMPTY;
  3337.           inA.GetProperty( j, kpidSize, size );
  3338.           FMaxProgress := FMaxprogress + size.uhVal.QuadPart;
  3339.           filesDW[ n ] := j;
  3340.           Inc( n );
  3341.         end; // For i := 0
  3342.  
  3343.       Filestoex := n;
  3344.     end else begin
  3345. //   extract all files, FFiles.Count must be 0
  3346.      FilestoEx := $FFFFFFFF;
  3347.     end;
  3348.  
  3349.     SetLength( filesDW, n );
  3350.  
  3351. //set FMaxProgress for selected files
  3352.   if FMaxProgress > 0 then if assigned( OnPreProgress ) then OnPreProgress( self,FMaxProgress );
  3353.  
  3354. // filesdw must be sorted asc
  3355.   if length( filesdw ) > 1 then SortDWord( filesDW,low( filesdw ),High( filesdw ) );
  3356.  
  3357.   updatecallback := TMyArchiveExtractCallback.Create( self );
  3358.   updatecallback.FExtractDirectory := appendslash( Fextrbasedir );
  3359.   updatecallback.FFilestoextract   := ffiles.Count; //with all files ffiles.count = 0, thats ok
  3360.   updatecallback.FAllFilesExt      := false;        //Stop extracting if no more files to extract
  3361.   updatecallback.FLastFileToExt    := false;        //only 1 more to extact
  3362.  
  3363.  
  3364.   result := inA.Extract( @filesDW[ 0 ], Filestoex, Integer( TestArchive ), updatecallback )
  3365.  
  3366. //  mmoLog.Lines.Add( Format( 'IInArchive.Extract: %d', [ result ] ) );
  3367. finally
  3368.   ina.close;
  3369.   ResetCancel;
  3370. end;
  3371. end;
  3372.  
  3373. procedure TSevenZip.ClearNamesOfVolumeWritten;
  3374. var
  3375.   i:Integer;
  3376. begin
  3377.   for i:=0 to length(FNamesOfVolumesWritten)-1 do
  3378.     FNamesOfVolumesWritten[i]:='';
  3379.   SetLength(FNamesOfVolumesWritten,0);
  3380.  
  3381. end;
  3382.  
  3383. procedure TSevenZip.SetLastError(const Value: Integer);
  3384. begin
  3385.   FLastError := Value;
  3386. end;
  3387.  
  3388.  
  3389.  
  3390. (*
  3391. function TSevenZip.Delete: Integer;
  3392. begin
  3393. //
  3394. end;
  3395. *)
  3396.  
  3397. //------------------------------------------------------------------------------------------------
  3398. //------------------------------------------------------------------------------------------------
  3399. //-----------------End SevenZip VCL---------------------------------------------------------
  3400. //------------------------------------------------------------------------------------------------
  3401. //------------------------------------------------------------------------------------------------
  3402.  
  3403. {$IFDEF RegisterInThisUnit}
  3404. procedure Register;
  3405. begin
  3406.   RegisterComponents( 'Seven Zip', [ TSevenZip ] );
  3407. end;
  3408. {$ENDIF}
  3409. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement