2D图形编程

开发平台：
Delphi

SevenZipVCL.pas：源码内容
							unit SevenZipVCL;
(*
   This Unit is under Mozilla Public Licence
    (
     - You can use this Unit for free in free, share and commercial application.
     - Mark clearly in your Readme or Help file that you use this unit/VCL with a link the
       SevenZipVCL Homepage ( http://www.rg-software.de )
     - Any changes of the source must be publised ( Just send it to me :- ) SevenZipVCL@rg-software.de )
    )
   TsevenZip by Ivo Andonov
   TSevenZipVCL by Rainer Geigenberger ( -> http://www.rg-software.de - SevenZipVCL@rg-software.de )
   Thanks to:
    - Marko Kamin
    - Craig Peterson
    - Roberto
    - Erik Smith
    - Sergey Prokhorov
   Dll Usage:
        For develpoment put the dll into the Windows directory
        Running the Application stand alone you can put the dll into the Application directory
 History:
   Version 0.1
    - Start
   Version 0.2
    - Changed everything to Widestring
    - Added WideStringList_
    - Added TWideStringArray
    - Adding RelativePath works
    - Adding works with Recursive Directory
    - Adding with Wildcards ( only *.txt or something )
    - Progress for files ( With SetCompleted VCL interaction works )
   Version 0.3
    - Added time reading and writing
   Version 0.4
    - Added Extract
    - Added Test via Extract( True )
    - Set Filetime during extraction
    - Progress during extraction works ( small files will not be displayed alone )
   Version 0.5
    - Changes here and there
    - Clean up code
   Version 0.6
    - Changed "Extract all files"
    - Fixed bug in handling directories during extract
    - Attribute to extracted files works now
    - Fixed LastwriteTime during adding
    - Changed some functions
   Version 0.6.1
    - Some minor changes
    - Fixed some bugs
    - Added MaxProgrees to selected files
    - Added some missing GUID - not used now :- )
   Version 0.6.2
    - Compression strength could be set
    - Drive letter to Storepath option included
    - Changes made by Marko Kamin
   Version 0.6.3
    - Changed Archive options to new type Addopts
    - Solid settings works now
   Version 0.6.4
    - Implemented SFX creation
   Version 0.6.4b
    - LZMAStrength added
   Version 0.6.5
    - PPMD method added
   Version 0.6.5a
    - Fixed bug during listing of 0 byte files
   
   Version 0.6.5b
    - Fixed bug during creating files for extract/SFXarchive in Tstreamwriter
   Version 0.6.5c
    - Fixed bug Creating SFX
   Version 0.6.6
    - Adding and extracting can be canceled
   Version 0.6.6a
    - Adding Extract without path
   Version 0.6.6c
    - Reading SFX
    - Number of files
    - New: IsSFX and SXFOffset
    - New: Function ConvertSFXto7z
    - New: Function Convert7ztoSFX
   Version 0.6.7
    - Added some Widestring function form TNTWare TNT Controls http://www.tntware.com/
    - New: OnExtractOverwrite - Do not work with Messageboxes right now
    - Include Extractoverwrite in Extractoption
   Version 0.6.7a
    - Changed constructor and destructor to avoid excaption - Thanks to Roberto jjw
    - Fixed Unicode bug during adding
   Version 0.6.7b
    - Clean up code. Thanks to Erik Smith
    - Rewrote Add function. Thanks to Erik Smith
	
   Version 0.6.7c
   - Multivolume support added - Thanks to Sergey Prokhorov
   - Begin password support - Thanks to Sergey Prokhorov
   Version 0.6.7e
   - Multivolume support improved
   - Clean up code
   Version 0.6.8a
   - Password implemented
   Version 0.6.8e
   - Implementation of 9x support started
   - Cleanup some comments
   Version 0.7.0
   - OpenarchiveCallback implemented
   - Encrypt filename option implemented
   Version 0.7.1
   - Fixed Bug in password support
   Version 0.7.1 -> modified by Lifepower (lifepower@mail333.com)
   - Very minor modifications to prevent unnecessary warnings
*)
(*
   Known Issues / Things ToDo:
   
    - No archive properties during listing
    - With Solid archives filenames and progress during extract comes very late ( at the end )
    - No deleting files from archive
  Please mark all changes with your sign and date e.g. rg 01.01.06
  and send it to me SevenZipVCL@rg-software.de
*)
// Use normal dll version
{$DEFINE Use7zdll}
// Lifepower (07-Jan-2007):
//  Disabled warnings W1002 and W1005 for platform-specific stuff.
{$WARN UNIT_PLATFORM OFF}
{$WARN SYMBOL_PLATFORM OFF}
// Use Resfile with 7z.dll, no external dll, accessing through BTMemoryModule
//{$DEFINE UseRes7zdll}
interface
{$IFDEF UseRes7zdll}
  {$R 7za.res}
{$ENDIF}
uses
  Windows, SysUtils, Classes, ActiveX,comobj,filectrl
  {$IFDEF UseRes7zdll}
  ,BTMemoryModule
  {$ENDIF}
  ;
const
//7z internal consts
//Extract
  //NAskMode
  kExtract = 0;
  kTest    = 1;
  kSkip    = 2;
  //NOperationResult
  kOK                = 0;
  kUnSupportedMethod = 1;
  kDataError         = 2;
  kCRCError          = 3;
  FNAME_MAX32 = 512;
// SevenZIP onMessage Errorcode
  FNoError           = 0;
  FFileNotFound      = 1;
  FDataError         = 2;
  FCRCError          = 3;
  FUnsupportedMethod = 4;
  FJustAnError       = 5;
  FUsercancel        = 6;
  FNoSFXarchive      = 7;
  FSFXModuleError    = 8;
const
  kpidNoProperty = 0;
  kpidHandlerItemIndex = 2;
  kpidPath = 3;
  kpidName = 4;
  kpidExtension = 5;
  kpidIsFolder = 6;
  kpidSize = 7;
  kpidPackedSize = 8;
  kpidAttributes = 9;
  kpidCreationTime = 10;
  kpidLastAccessTime = 11;
  kpidLastWriteTime = 12;
  kpidSolid = 13;
  kpidCommented = 14;
  kpidEncrypted = 15;
  kpidSplitBefore = 16;
  kpidSplitAfter = 17;
  kpidDictionarySize = 18;
  kpidCRC = 19;
  kpidType = 20;
  kpidIsAnti = 21;
  kpidMethod = 22;
  kpidHostOS = 23;
  kpidFileSystem = 24;
  kpidUser = 25;
  kpidGroup = 26;
  kpidBlock = 27;
  kpidComment = 28;
  kpidPosition = 29;
  kpidTotalSize = $1100;
  kpidFreeSpace = $1101;
  kpidClusterSize = $1102;
  kpidVolumeName = $1103;
  kpidLocalName = $1200;
  kpidProvider = $1201;
  kpidUserDefined = $10000;
//jjw 18.10.2006
type
  TCreateObjectFunc = function ( const clsid: PGUID; const iid: PGUID; out _out ): Integer; stdcall;
//----------------------------------------------------------------------------------------------------
//--------------Widestring Classes--------------------------------------------------------------------
//----------------------------------------------------------------------------------------------------
type
  TWideStringArray = array of WideString;
  TWideStringList_ = class( TObject )
   private
   public
    WStrings: array of WideString;
    Count: Longword;
    constructor Create;
    procedure Clear;
    procedure AddString( s: WideString );
    procedure RemoveString( s: WideString );
   end;
type
  TCompressType = ( LZMA,PPMD );
  TCompressStrength = ( SAVE,FAST,NORMAL,MAXIMUM,ULTRA );
  TLZMAStrength = 0..27;
  TPPMDMem = 1..31;
  TPPMDSize = 2..32;
  AddOptsEnum = ( AddRecurseDirs, AddSolid, AddStoreOnlyFilename, AddIncludeDriveLetter, AddEncryptFilename );
  AddOpts = Set Of AddOptsEnum;
  ExtractOptsEnum = ( ExtractNoPath,ExtractOverwrite );
  ExtractOpts = Set Of ExtractOptsEnum;
//----------------------------------------------------------------------------------------------------
//----------------------------------------------------------------------------------------------------
//--------------Start SevenZip Interface-------------------------------------------------------
//----------------------------------------------------------------------------------------------------
//----------------------------------------------------------------------------------------------------
type
  TInterfacedObject = class( TObject, IUnknown )
  protected
    FRefCount: Integer;
    function QueryInterface( const IID: TGUID; out Obj ): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function NewInstance: TObject; override;
    property RefCount: Integer read FRefCount;
  end;
const
//  Correct below for 7-Zip 4.23 or 4.29. Comment this line
  {$DEFINE 7z423_}
  {$DEFINE 7z429}
  {$IFDEF 7z423}
  szCLSID_CFormat7z = '{23170F69-40C1-278A-1000-000110050000}';
  szIID_IInArchive = '{23170F69-40C1-278A-0000-000100080000}';
  szIID_IOutArchive = '{23170F69-40C1-278A-0000-000100020000}';
  szIID_ISetProperties = '{23170F69-40C1-278A-0000-000100030000}';
  szIID_IOutStream = '{23170F69-40C1-278A-0000-000000040000}';
  szIID_ISequentialInStream = '{23170F69-40C1-278A-0000-000000010000}';
  szIID_IInStream = '{23170F69-40C1-278A-0000-000000030000}';
  szIID_IStreamGetSize = '{23170F69-40C1-278A-0000-000000060000}';
  szIID_IArchiveOpenCallback = '{23170F69-40C1-278A-0000-000100010000}';
  szIID_IArchiveExtractCallback = '{23170F69-40C1-278A-0000-000100090000}';
  szIID_IArchiveUpdateCallback = '{23170F69-40C1-278A-0000-000100040000}';
  szIID_IProgress = '{23170F69-40C1-278A-0000-000000050000}';
  szIID_ISequentialOutStream = '{23170F69-40C1-278A-0000-000000020000}';
  {$ENDIF}
  {$IFDEF 7z429}
//000
  szIID_IProgress =                         '{23170F69-40C1-278A-0000-000000050000}';
//30
  szIID_ISequentialInStream =               '{23170F69-40C1-278A-0000-000300010000}';
  szIID_ISequentialOutStream =              '{23170F69-40C1-278A-0000-000300020000}';
  szIID_IInStream =                         '{23170F69-40C1-278A-0000-000300030000}';
  szIID_IOutStream =                        '{23170F69-40C1-278A-0000-000300040000}';
  szIID_IStreamGetSize =                    '{23170F69-40C1-278A-0000-000300060000}';
  szIID_IOutStreamFlush =                   '{23170F69-40C1-278A-0000-000300070000}';
//400
  szIID_ICompressProgressInfo =             '{23170F69-40C1-278A-0000-000400040000}';
  szIID_ICompressCoder =                    '{23170F69-40C1-278A-0000-000400050000}';
  szIID_ICompressCoder2 =                   '{23170F69-40C1-278A-0000-000400180000}';
  szIID_ICompressSetCoderProperties =       '{23170F69-40C1-278A-0000-000400200000}';
  szIID_ICompressSetDecoderProperties =     '{23170F69-40C1-278A-0000-000400210000}';
  szIID_ICompressSetDecoderProperties2 =    '{23170F69-40C1-278A-0000-000400220000}';
  szIID_ICompressWriteCoderProperties =     '{23170F69-40C1-278A-0000-000400230000}';
  szIID_ICompressGetInStreamProcessedSize = '{23170F69-40C1-278A-0000-000400240000}';
  szIID_ICompressGetSubStreamSize =         '{23170F69-40C1-278A-0000-000400300000}';
  szIID_ICompressSetInStream =              '{23170F69-40C1-278A-0000-000400310000}';
  szIID_ICompressSetOutStream =             '{23170F69-40C1-278A-0000-000400320000}';
  szIID_ICompressSetInStreamSize =          '{23170F69-40C1-278A-0000-000400330000}';
  szIID_ICompressSetOutStreamSize =         '{23170F69-40C1-278A-0000-000400340000}';
  szIID_ICompressFilter =                   '{23170F69-40C1-278A-0000-000400400000}';
  szIID_ICryptoProperties =                 '{23170F69-40C1-278A-0000-000400800000}';
  szIID_ICryptoSetPassword =                '{23170F69-40C1-278A-0000-000400900000}';
  szIID_ICryptoSetCRC =                     '{23170F69-40C1-278A-0000-000400A00000}';
//500
  szIID_ICryptoGetTextPassword =            '{23170F69-40C1-278A-0000-000500100000}';
  szIID_ICryptoGetTextPassword2 =           '{23170F69-40C1-278A-0000-000500110000}';
//600
  szIID_ISetProperties =                    '{23170F69-40C1-278A-0000-000600030000}';
  szIID_IArchiveOpenCallback =              '{23170F69-40C1-278A-0000-000600100000}';
  szIID_IArchiveExtractCallback =           '{23170F69-40C1-278A-0000-000600200000}';
  szIID_IArchiveOpenVolumeCallback =        '{23170F69-40C1-278A-0000-000600300000}';
  szIID_IInArchiveGetStream =               '{23170F69-40C1-278A-0000-000600400000}';
  szIID_IArchiveOpenSetSubArchiveName =     '{23170F69-40C1-278A-0000-000600500000}';
  szIID_IInArchive =                        '{23170F69-40C1-278A-0000-000600600000}';
  szIID_IArchiveUpdateCallback =            '{23170F69-40C1-278A-0000-000600800000}';
  szIID_IArchiveUpdateCallback2 =           '{23170F69-40C1-278A-0000-000600820000}';
  szIID_IOutArchive =                       '{23170F69-40C1-278A-0000-000600A00000}';
  szCLSID_CFormat7z =                       '{23170F69-40C1-278A-1000-000110070000}';
  szIID_CCrypto_Hash_SHA256                = '{23170F69-40C1-278B-0703-000000000000}';
  szIID_CCrypto7zAESEncoder                = '{23170F69-40C1-278B-06F1-070100000100}';
  szIID_CCrypto7zAESDecoder                = '{23170F69-40C1-278B-06F1-070100000000}';
  {$ENDIF}
  CLSID_CFormat7z: TGUID = szCLSID_CFormat7z;
  IID_IInArchive: TGUID = szIID_IInArchive;
  IID_IOutArchive: TGUID = szIID_IOutArchive;
  IID_ISetProperties: TGUID = szIID_ISetProperties;
  IID_ICompressCoder: TGUID = szIID_ICompressCoder;
  IID_ICryptoGetTextPassword: TGUID = szIID_ICryptoGetTextPassword;
  IID_ICryptoGetTextPassword2: TGUID = szIID_ICryptoGetTextPassword2;
  IID_ICryptoSetPassword: TGUID = szIID_ICryptoSetPassword;
  IID_IOutStream: TGUID = szIID_IOutStream;
  IID_ISequentialInStream: TGUID = szIID_ISequentialInStream;
  IID_IInStream: TGUID = szIID_IInStream;
  IID_IStreamGetSize: TGUID = szIID_IStreamGetSize;
  IID_IArchiveOpenCallback: TGUID = szIID_IArchiveOpenCallback;
  IID_ICompressGetSubStreamSize: TGUID = szIID_ICompressGetSubStreamSize;
  IID_IArchiveOpenSetSubArchiveName: TGUID = szIID_IArchiveOpenSetSubArchiveName;
  IID_IArchiveExtractCallback: TGUID = szIID_IArchiveExtractCallback;
  IID_IArchiveOpenVolumeCallback: TGUID = szIID_IArchiveOpenVolumeCallback;
  IID_IArchiveUpdateCallback: TGUID = szIID_IArchiveUpdateCallback;
  IID_IArchiveUpdateCallback2: TGUID = szIID_IArchiveUpdateCallback2;
  IID_IProgress: TGUID = szIID_IProgress;
  IID_ISequentialOutStream: TGUID = szIID_ISequentialOutStream;
  IID_CCrypto7zAESEncoder: TGUID = szIID_CCrypto7zAESEncoder;
type
  HARC = THandle;
  INDIVIDUALINFO = record
    dwOriginalSize: DWORD;
    dwCompressedSize: DWORD;
    dwCRC: DWORD;
    uFlag: UINT;
    uOSType: UINT;
    wRatio: WORD;
    wDate: WORD;
    wTime: WORD;
    szFileName: array [ 0..FNAME_MAX32 + 1 - 1 ] of Char;
    dummy1: array [ 0..3 - 1 ] of Char;
    szAttribute: array [ 0..8 - 1 ] of Char;
    szMode: array [ 0..8 - 1 ] of Char;
  end;
  EXTRACTINGINFO = record
    dwFileSize: DWORD;
    dwWriteSize: DWORD;
    szSourceFileName: array [ 0..FNAME_MAX32 + 1 - 1 ] of Char;
    dummy1: array [ 0..3 - 1 ] of Char;
    szDestFileName: array [ 0..FNAME_MAX32 + 1 - 1 ] of Char;
    dummy: array [ 0..3 - 1 ] of Char;
  end;
  PEXTRACTINGINFOEX = ^EXTRACTINGINFOEX;
  EXTRACTINGINFOEX = record
    exinfo: EXTRACTINGINFO;
    dwCompressedSize: DWORD;
    dwCRC: DWORD;
    uOSType: UINT;
    wRatio: WORD;
    wDate: WORD;
    wTime: WORD;
    szAttribute: array [ 0..8 - 1 ] of Char;
    szMode: array [ 0..8 - 1 ] of Char;
  end;
type
  ISetProperties = interface( IUnknown )
    [ szIID_ISetProperties ]
    function SetProperties( const names: PWideChar; const values: PPROPVARIANT; numProperties: Integer ): Integer; stdcall;
  end;
  ICompressProgressInfo = interface( IUnknown )
    [ szIID_ICompressProgressInfo ]
    function SetRatioInfo( const inSize, outSize: Int64 ): Integer; stdcall;
  end;
  ISequentialOutStream = interface( IUnknown )
    [ szIID_ISequentialOutStream ]
    function Write( const data; size: DWORD; processedSize: PDWORD ): Integer; stdcall;
    {$IFDEF 7z423}
    function WritePart( const data; size: DWORD; processedSize: PDWORD ): Integer; stdcall;
    {$ENDIF}
  end;
  ISequentialInStream = interface( IUnknown )
    [ szIID_ISequentialInStream ]
    function Read( var data; size: DWORD; processedSize: PDWORD ): Integer; stdcall;
    {$IFDEF 7z423}
    function ReadPart( var data; size: DWORD; processedSize: PDWORD ): Integer; stdcall;
    {$ENDIF}
  end;
  ICryptoGetTextPassword = interface( IUnknown )
    [ szIID_ICryptoGetTextPassword ]
    function CryptoGetTextPassword( var Password: PWideChar ): Integer; stdcall;
  end;
  ICryptoGetTextPassword2 = interface( IUnknown )
    [ szIID_ICryptoGetTextPassword2 ]
    function CryptoGetTextPassword2( passwordIsDefined: PInteger; var Password: PWideChar ): Integer; stdcall;
  end;
  ICryptoProperties = interface( IUnknown )
    [ szIID_ICryptoProperties ]
    function SetKey( const Data; Size: DWORD ): Integer; stdcall;
    function SetInitVector( const Data; Size: DWORD ): Integer; stdcall;
  end;
  ICompressCoder = interface( IUnknown )
    [ szIID_ICompressCoder ]
    function Code( inStream: ISequentialInStream; outStream: ISequentialOutStream;
      const inSize, outSize: Int64; Progress: ICompressProgressInfo ): Integer; stdcall;
  end;
  ICryptoSetPassword = interface( IUnknown )
    [ szIID_ICryptoSetPassword ]
    function CryptoSetPassword( const Data; Size: DWORD ): Integer; stdcall;
  end;
  ICryptoSetCRC = interface( IUnknown )
    [ szIID_ICryptoSetCRC ]
    function CryptoSetCRC( CRC: DWORD ): Integer; stdcall;
  end;
  IInStream = interface( ISequentialInStream )
    [ szIID_IInStream ]
    function Seek( offset: Int64; seekOrigin: DWORD;newPosition: PInt64 ): Integer; stdcall;
  end;
  IStreamGetSize = interface( IUnknown )
    [ szIID_IStreamGetSize ]
    function GetSize( var size: Int64 ): Integer; stdcall;
  end;
  IArchiveOpenCallback = interface( IUnknown )
    [ szIID_IArchiveOpenCallback ]
    function SetTotal( const files: Int64; const bytes: Int64 ): Integer; stdcall;
    function SetCompleted( const files: Int64; const bytes: Int64 ): Integer; stdcall;
  end;
  IArchiveOpenVolumeCallback = interface( IUnknown )
    [ szIID_IArchiveOpenVolumeCallback ]
    function GetProperty( propID: PROPID; var value: PROPVARIANT ): Integer; stdcall;
    function GetStream( const name:Widechar; var inStream: IInStream ): Integer; stdcall;
  end;
  IArchiveOpenSetSubArchiveName = interface( IUnknown )
    [ szIID_IArchiveOpenSetSubArchiveName ]
    function SetSubArchiveName( const Name: PWideString ): Integer; stdcall;
  end;
  IProgress = interface( IUnknown )
    [ szIID_IProgress ]
    function SetTotal( total: Int64 ): Integer; stdcall;
    function SetCompleted( const completeValue: PInt64 ): Integer; stdcall;
  end;
  IArchiveExtractCallback = interface( IProgress )
    [ szIID_IArchiveExtractCallback ]
    function GetStream( index: DWORD; out outStream: ISequentialOutStream;  askExtractMode: DWORD ): Integer; stdcall;
    // GetStream OUT: S_OK - OK, S_FALSE - skeep this file
    function PrepareOperation( askExtractMode: Integer ): Integer; stdcall;
    function SetOperationResult( resultEOperationResult: Integer ): Integer; stdcall;
  end;
  IInArchive = interface( IUnknown )
    [ szIID_IInArchive ]
    function Open( stream: IInStream; const maxCheckStartPosition: PInt64; openArchiveCallback: IArchiveOpenCallback ): Integer; stdcall;
    function Close( ): Integer; stdcall;
    function GetNumberOfItems( out numItems: DWORD ): Integer; stdcall;
    function GetProperty( index: DWORD; propID: PROPID; var value: PROPVARIANT ): Integer; stdcall;
    function Extract( const indices: PDWORD; numItems: DWORD;   testMode: Integer; extractCallback: IArchiveExtractCallback ): Integer; stdcall;
    function GetArchiveProperty( propID: PROPID; value: PPROPVARIANT ): Integer; stdcall;
    function GetNumberOfProperties( var numProperties: DWORD ): Integer; stdcall;
    function GetPropertyInfo( index: DWORD; var name: TBSTR; var propID: PROPID; var varType: {PVARTYPE}Integer ): Integer; stdcall;
    function GetNumberOfArchiveProperties( var numProperties ): Integer; stdcall;
    function GetArchivePropertyInfo( index: DWORD; name: PBSTR; propID: PPROPID; varType: {PVARTYPE}PInteger ): Integer; stdcall;
  end;
  IArchiveUpdateCallback = interface( IProgress )
    [ szIID_IArchiveUpdateCallback ]
    //function EnumProperties( var enumerator: IEnumSTATPROPSTG ): Integer; stdcall;
    function GetUpdateItemInfo( index: DWORD;
      newData: PInteger; // 1 - new data, 0 - old data
      newProperties: PInteger; // 1 - new properties, 0 - old properties
      indexInArchive: PDWORD // -1 if there is no in archive, or if doesn't matter
      ): Integer; stdcall;
    function GetProperty( index: DWORD; propID: PROPID; value: PPROPVARIANT ): Integer; stdcall;
    function GetStream( index: DWORD; var inStream: ISequentialInStream ): Integer; stdcall;
    function SetOperationResult( operationResult: Integer ): Integer; stdcall;
  end;
  IArchiveUpdateCallback2 = interface( IProgress )
    [ szIID_IArchiveUpdateCallback2 ]
    //function EnumProperties( var enumerator: IEnumSTATPROPSTG ): Integer; stdcall;
    function GetVolumeSize( index: DWORD; Size:DWord ): Integer; stdcall;
    function GetVolumeStream( index: DWORD; var volumeStream: ISequentialInStream ): Integer; stdcall;
  end;
  IOutArchive = interface( IUnknown )
    [ szIID_IOutArchive ]
    function UpdateItems( outStream: ISequentialOutStream; numItems: DWORD; updateCallback: IArchiveUpdateCallback ): Integer; stdcall;
    function GetFileTimeType( var _type: DWORD ): Integer; stdcall;
  end;
  IOutStream = interface( ISequentialOutStream )
    [ szIID_IOutStream ]
    function Seek( offset: Int64; seekOrigin: DWORD; newPosition: PInt64 ): Integer; stdcall;
    function SetSize( newSize: Int64 ): Integer; stdcall;
  end;
// -----------------------------------------------------------------------------
  TSevenZip = class;   // for reference only, implementated later below
  TOpenVolume = procedure( var arcFileName: WideString; Removable: Boolean; out Cancel: Boolean ) of object;
  TFiles = record
    Name: WideString;
    Handle: Integer;
    Size: DWORD;
    OnRemovableDrive: Boolean;
  end;
  TMyStreamWriter = class( TInterfacedObject, ISequentialOutStream, IOutStream )
  private
    arcName: WideString;
    arcDate: Tdatetime;
    arcAttr: DWORD;
    arcCreateSFX: Boolean;
    arcVolumeSize: DWORD;
    arcPosition, arcSize: DWORD;
    Files: array of TFiles;
    function CreateNewFile: Boolean;
  public
    destructor Destroy; override;
    constructor Create( sz: Widestring; szDate: Tdatetime; FAttr: Cardinal; VolumeSize: Integer = 0; CreateSFX: Boolean = FALSE );
    function Write( const Data; Size: DWORD; ProcessedSize: PDWORD ): Integer; stdcall;
    function WritePart( const Data; Size: DWORD; ProcessedSize: PDWORD ): Integer; stdcall;
    function Seek( Offset: Int64; SeekOrigin: DWORD; NewPosition: PInt64 ): Integer; stdcall;
    function SetSize( newSize: Int64 ): Integer; stdcall;
  end;
  TMyStreamReader = class( TInterfacedObject, IInStream, IStreamGetSize, ISequentialInStream )
    FSevenZip: TSevenZip;
    arcName: WideString;
    arcPosition, arcSize: DWORD;
    Files: array of TFiles;
    FOnOpenVolume: TOpenVolume;
    FArchive: Boolean;
    FMultivolume: Boolean;
    function BrowseForFile( Title: PWideChar; var Name: WideString ): Boolean;
    function OpenVolume( Index: Integer ): Boolean;
    function OpenNextVolume: Boolean;
    function OpenLastVolume: Boolean;
  public
    constructor Create( Owner: TSevenZip; sz: Widestring; asArchive: Boolean );
    destructor Destroy; override;
    function Seek( Offset: Int64; SeekOrigin: DWORD; NewPosition: PInt64 ): Integer; stdcall;
    function Read( var Data; Size: DWORD; ProcessedSize: PDWORD ): Integer; stdcall;
    function ReadPart( var Data; Size: DWORD; ProcessedSize: PDWORD ): Integer; stdcall;
    function GetSize( var Size: Int64 ): Integer; stdcall;
  end;
// -----------------------------------------------------------------------------
  TMyArchiveUpdateCallback = class( TInterfacedObject, IArchiveUpdateCallback, ICryptoGetTextPassword2, IProgress )
    FSevenZip: TSevenZip;
    Files: TWideStringArray;//TStringList;
    Files_size: array of int64;
    Files_Date: array of TFiletime;
    Files_Attr: array of Cardinal;
    FProgressFile: Widestring;
    FProgressFilePos: int64;
    FprogressFileSize: int64;
    FLastPos: int64;
    RootDir: WideString;
    FPassword: WideString;
//    FIncludeDriveletter: Boolean;
    constructor Create( Owner: TSevenZip );
//    destructor destroy;
//    function EnumProperties( var enumerator: IEnumSTATPROPSTG ): Integer; stdcall;
    function GetUpdateItemInfo(
      index: DWORD;
      newData: PInteger; // 1 - new data, 0 - old data
      newProperties: PInteger; // 1 - new properties, 0 - old properties
      indexInArchive: PDWORD // -1 if there is no in archive, or if doesn't matter
    ): Integer; stdcall;
    function GetProperty( index: DWORD; propID: PROPID; value: PPROPVARIANT ): Integer; stdcall;
    function GetStream( index: DWORD; var inStream: ISequentialInStream ): Integer; stdcall;
    function SetOperationResult( operationResult: Integer ): Integer; stdcall;
// Shadow 29.11.2006
    function CryptoGetTextPassword2( passwordIsDefined: PInteger; var Password: PWideChar ): Integer; stdcall;
    function SetTotal( total: Int64 ): Integer; stdcall;
    function SetCompleted( const completeValue: PInt64 ): Integer; stdcall;
  end;
  TMyArchiveExtractCallback = class( TInterfacedObject, IArchiveExtractCallback, ICryptoGetTextPassword )
    FSevenzip: TSevenzip;
    FExtractDirectory: Widestring;
    FProgressFile: Widestring;
    FProgressFilePos: int64;
    FProgressFileSize: int64;
    FLastPos: int64;
    FFilestoextract: int64;
    FLastFileToExt: Boolean;
    FAllFilesExt: Boolean;
    FPassword: WideString;
    constructor Create( Owner: TSevenZip );
    function GetStream( index: DWORD; out outStream: ISequentialOutStream; askExtractMode: DWORD ): Integer; stdcall;
    // GetStream OUT: S_OK - OK, S_FALSE - skeep this file
    function PrepareOperation( askExtractMode: Integer ): Integer; stdcall;
    function SetOperationResult( resultEOperationResult: Integer ): Integer; stdcall;
    function SetTotal( total: Int64 ): Integer; stdcall;
    function SetCompleted( const completeValue: PInt64 ): Integer; stdcall;
// Shadow 29.11.2006
    function CryptoGetTextPassword( var Password: PWideChar ): Integer; stdcall;
  end;
  TMyArchiveOpenCallback = class( TInterfacedObject, IArchiveOpenCallback, ICryptoGetTextPassword )
    FSevenzip: TSevenzip;
    FPassword: WideString;
    constructor Create( Owner: TSevenZip );
    function SetTotal( const files: Int64; const bytes: Int64 ): Integer; stdcall;
    function SetCompleted( const files: Int64; const bytes: Int64 ): Integer; stdcall;
    function CryptoGetTextPassword( var Password: PWideChar ): Integer; stdcall;
  end;
//----------------------------------------------------------------------------------------------------
//----------------------------------------------------------------------------------------------------
//--------------END SevenZip Interface--------------------------------------------------------
//----------------------------------------------------------------------------------------------------
//----------------------------------------------------------------------------------------------------
  
  
//----------------------------------------------------------------------------------------------------  
//----------------------------------------------------------------------------------------------------  
//--------------Start SevenZip VCL -------------------------------------------------------------  
//----------------------------------------------------------------------------------------------------  
//----------------------------------------------------------------------------------------------------  
//type
  TListfileEvent = procedure( Sender: TObject; Filename: Widestring; Fileindex,FileSizeU,FileSizeP,Fileattr,Filecrc:cardinal;Filemethod:Widestring ;FileTime:double ) of object;
  TExtractfileEvent = procedure( Sender: TObject; Filename: Widestring; Filesize:int64 ) of object;
  TAddFileEvent = procedure( Sender: TObject; Filename: Widestring; Filesize:int64 ) of object;
  TPreProgressEvent = procedure( Sender: TObject; MaxProgress: int64 ) of object;
  TProgressEvent = procedure( Sender: TObject; Filename: Widestring; FilePosArc,FilePosFile: int64 ) of object;
  TMessageEvent = procedure( Sender: TObject; ErrCode: Integer; Message: string;Filename:Widestring )  of object;
//  TCRC32ErrorEvent = procedure( Sender: TObject; ForFile: string;  FoundCRC, ExpectedCRC: LongWord; var DoExtract: Boolean ) of object;
//  TCommentEvent = procedure( Sender: TObject;Comment: string; ) of object;
  TSetNewNameEvent = procedure( Sender: TObject; var OldFileName: WideString ) of object;
  TExtractOverwrite = procedure( Sender: TObject; FileName: WideString; var DoOverwrite: Boolean ) of object;
//type
  TSevenZip = class( TComponent )
  private
    FErrCode: Integer;
    FHandle: HWND;
//    FMessage: Widestring; // Not used now ErikGG 08.11.06
    FExtrBaseDir: Widestring;
    FSevenZipFileName: Widestring;
    FComment: Widestring;
    FRootDir: Widestring;
    Ffiles: TWideStringList_;
    { Event variables }
    FOnProgress: TProgressEvent;
    FOnPreProgress: TPreProgressEvent;
    FOnMessage: TMessageEvent;
    FOnlistfile: TlistfileEvent;
    FOnextractfile: TextractfileEvent;
    FOnaddfile: TaddfileEvent;
    FOnSetAddName: TSetNewNameEvent;
    FOnSetExtractName: TSetNewNameEvent;
    FOnExtractOverwite: TExtractOverwrite;
    FAddOptions: Addopts;
    FExtractOptions: Extractopts;
    FNumberOfFiles: Integer;
    FIsSFX: Boolean;
    FSFXOffset: Int64;
    FSFXCreate: Boolean;
    FSFXModule: Widestring;
    FCompresstype: TCompresstype;
    FCompstrength: TCompressStrength;
    FLZMAStrength: TLZMAStrength;
    FPPMDSize: TPPMDSize;
    FPPMDMem: TPPMDMem;
    FMainCancel: Boolean;
// Shadow 28.11.2006
    F7zaLibh: THandle;
{$IFDEF UseRes7zdll}
    mp_MemoryModule: PBTMemoryModule;
    mp_DllData: Pointer;
    m_DllDataSize: Integer;
{$ENDIF}
    FCreateObject: TCreateObjectFunc;
    FVolumeSize: Integer;
    FOnOpenVolume: TOpenVolume;
    FPassword: WideString;
    { Private "helper" functions }
//    procedure LogMessage( var msg: TMessage ); message 9999;
    procedure ResetCancel;
    function AppendSlash( sDir: widestring ): widestring;
    procedure SetVolumeSize( const Value: Integer );
    procedure SetSFXCreate( const Value: Boolean );
  protected
    inA: IInArchive;
    outA: IOutArchive;
    sp: ISetProperties;
  public
    constructor Create( AOwner: TComponent ); override;
    destructor Destroy; override;
    { Public Properties ( run-time only ) }
    property Handle: HWND read fHandle write fHandle;
    property ErrCode: Integer read fErrCode write fErrCode;
    property IsSFX: Boolean read FIsSFX write FIsSFX;
    property SFXOffset: int64 read FSFXOffset write FSFXOffset;
    property SevenZipComment: Widestring read Fcomment write FComment;
    property Files: TWideStringList_ read Ffiles write ffiles;
    { Public Methods }
    function Add: Integer;
    function Extract( TestArchive:Boolean=False ): Integer;
    function List: Integer;
    procedure Cancel;
    function GetIndexByFilename( FileToExtract:Widestring ): Integer;
    function SFXCheck( Fn:Widestring ): Boolean;
    function ConvertSFXto7z( Fn:Widestring ): boolean;
    function Convert7ztoSFX( Fn:Widestring ): boolean;
  published
    { Public properties that also show on Object Inspector }
    property AddRootDir: Widestring read FRootDir write FRootDir;
    property SFXCreate: Boolean read FSFXCreate write SetSFXCreate;
    property SFXModule: Widestring read FSFXModule write FSFXModule;
    property AddOptions: AddOpts read FAddOptions write FAddOptions;
    property ExtractOptions: ExtractOpts read FExtractOptions write FExtractOptions;
    property ExtrBaseDir: Widestring read FExtrBaseDir write FExtrBaseDir;
    property LZMACompressType: TCompresstype read FCompresstype write FCompresstype;
    property LZMACompressStrength: TCompressStrength read FCompstrength write FCompstrength;
    property LZMAStrength: TLZMAStrength read FLZMAStrength write FLZMAstrength;
    property LPPMDmem: TPPMDmem read FPPMDmem write FPPMDmem;
    property LPPMDsize: TPPMDsize read FPPMDsize write FPPMDsize;
    property SZFileName: Widestring read FSevenZipFileName write FSevenZipFilename;
    property NumberOfFiles: Integer read FNumberOfFiles write FNumberOfFiles;
// Shadow 29.11.2006
    property VolumeSize: Integer read FVolumeSize write SetVolumeSize;
    property Password: WideString read FPassword write FPassword;
    { Events }
    property OnListfile: TlistfileEvent read FOnlistfile write FOnlistfile;
    property OnAddfile: TaddfileEvent read FOnaddfile write FOnaddfile;
    property OnExtractfile: TextractfileEvent read FOnextractfile write FOnextractfile;
    property OnProgress: TProgressEvent read FOnProgress  write FOnProgress;
    property OnPreProgress: TPreProgressEvent read FOnPreProgress  write FOnPreProgress;
    property OnMessage: TMessageEvent read fOnMessage write fOnMessage;
    property OnSetAddName: TSetNewNameEvent read FOnSetAddName write FOnSetAddName;
    property OnSetExtractName: TSetNewNameEvent read FOnSetExtractName write FOnSetExtractName;
    property OnExtractOverwrite: TExtractOverwrite read FOnExtractOverwite write FOnExtractOverwite;
    property OnOpenVolume: TOpenVolume read FOnOpenVolume write FOnOpenVolume;
  end;
// jjw 18.10.2006 FCreateobject - function CreateObject( const clsid: PGUID; const iid: PGUID; out _out ): Integer; stdcall; external '7za.dll';
function PropTypeToString( propType: Integer ): string;
function PropIDToString( propID: Integer ): string;
procedure Log( sz: string );
function FileTimeToDateTime( const rFileTime: TFileTime; const Localize: Integer = 0 ): TDateTime;
procedure SortDWord( var A: array of DWord; iLo, iHi: DWord );
function DriveIsRemovable( Drive: WideString ): Boolean;
function TryStrToInt_( const S: string; out Value: Integer ): Boolean;
//Unicode procedures
function UppercaseW_( s:WideString ):Widestring;
function GetFileSizeandDateTime_Int64( fn: Widestring; var fs:int64; var ft:Tfiletime; var fa:Integer ): int64;
function FileExists_( fn: Widestring ): Boolean;
function createfile_(lpFileName:Pwidechar; Access:Cardinal; Share:Cardinal;SecAttr:PSecurityattributes;
                     CreationDisposition:Cardinal;Flags:Cardinal;Temp:Cardinal) : integer;
procedure Register;
var FMainhandle: HWND; //for debug messages
var isUnicode : Boolean;
implementation
uses
  Forms, CommDlg;
//--------------------------------------------------------------------------------------------------
//-------------------Start UniCode procedures-------------------------------------------------------
//--------------------------------------------------------------------------------------------------
function isEqualW( s1, s2: WideString ): Boolean;
var
  i: Integer;
begin
  Result := FALSE;
  if Length( s1 ) <> Length( s2 ) then Exit;
  for i := 1 to Length( s1 ) do if WideChar( s1[ i ] ) <> WideChar( s2[ i ] ) then Exit;
  Result := TRUE;
end;
function FileExists_( fn: Widestring ): Boolean;
var
 fs:int64;
 ft:Tfiletime;
 fa:Integer;
begin
 if isUnicode then
   Result := ( GetFileSizeandDateTime_Int64( fn,fs,ft,fa ) > -1 )
  else
   Result := fileexists(string(fn));
end;
function PrevDir( Path: WideString ): WideString;
var
  l: Integer;
begin
  l := Length( Path );
  if ( l > 0 ) and ( Path[ l ] = '' ) then Dec( l );
  while Path[ l ] <> '' do Dec( l );
  Result := Copy( Path, 1, l );
end;
function ClearSlash( Path: WideString ): WideString;
var
  l: Integer;
begin
  l := Length( Path );
  if Path[ l ] = '' then Dec( l );
  Result := Copy( Path, 1, l );
end;
function DirectoryExistsW( const Directory: WideString ): Boolean;
var
  Code: Integer;
begin
  Code := GetFileAttributesW( PWideChar( Directory ) );
  Result := ( Code <> -1 ) and ( FILE_ATTRIBUTE_DIRECTORY and Code <> 0 );
end;
//START function from TNTControls http://www.tntware.com/
function StrScanWide( const Str: PWideChar; Chr: WideChar ): PWideChar;
begin
  Result := Str;
  while Result^ <> Chr do
  begin
    if Result^ = #0 then
    begin
      Result := nil;
      Exit;
    end;
    Inc( Result );
  end;
end;
function LastDelimiterW( const Delimiters, S: WideString ): Integer;
var
  P: PWideChar;
begin
  Result := Length( S );
  P := PWideChar( Delimiters );
  while Result > 0 do
  begin
    if ( S[ Result ] <> #0 ) and ( StrScanWide( P, S[ Result ] ) <> nil ) then
      Exit;
    Dec( Result );
  end;
end;
function ChangeFileExtW( const FileName, Extension: WideString ): WideString;
var
  I: Integer;
begin
  I := LastDelimiterW( '.:',Filename );
  if ( I = 0 ) or ( FileName[ I ] <> '.' ) then I := MaxInt;
  Result := Copy( FileName, 1, I - 1 ) + Extension;
end;
function ExtractFilePathW( const FileName: WideString ): WideString;
var
  I: Integer;
begin
  I := LastDelimiterW( ':', FileName );
  Result := Copy( FileName, 1, I );
end;
function ExtractFileNameW( const FileName: WideString ): WideString;
var
  I: Integer;
begin
  I := LastDelimiterW( ':', FileName );
  Result := Copy( FileName, I + 1, MaxInt );
end;
function ExtractFileExtW( const FileName: WideString ): WideString;
var
  I: Integer;
begin
  I := LastDelimiterW( '.:', FileName );
  if ( I > 0 ) and ( FileName[ I ] = '.' ) then
    Result := Copy( FileName, I, MaxInt ) else
    Result := '';
end;
//END function from TNTControls http://www.tntware.com/
function GetFileSizeandDateTime_Int64( fn: Widestring; var fs:int64; var ft:Tfiletime; var fa:Integer ): int64;
var
  FindDataW: _Win32_Find_Dataw;
  FindDataA: _Win32_Find_DataA;
  SearchHandle: THandle;
begin
  Result := 0;
  if isUnicode then
   SearchHandle := FindFirstFilew( PWideChar( fn ), FindDataW )
  else
    SearchHandle := FindFirstFile( PAnsiChar( Ansistring( fn ) ), FindDataA );
  if SearchHandle = INVALID_HANDLE_VALUE then
   begin
    Result := -1;
    fs := -1;
    fa := -1;
    ft.dwLowDateTime := 0;
    ft.dwHighDateTime := 0;
    exit;
   end;
  if isUnicode then
   begin
     LARGE_Integer( Result ).LowPart := FindDataW.nFileSizeLow;
     LARGE_Integer( Result ).HighPart := FindDataW.nFileSizeHigh;
     LARGE_Integer( fs ).LowPart := FindDataW.nFileSizeLow;
     LARGE_Integer( fs ).HighPart := FindDataW.nFileSizeHigh;
     ft.dwLowDateTime  := FinddataW.ftLastWriteTime.dwLowDateTime;
     ft.dwHighDateTime := FinddataW.ftLastWriteTime.dwHighDateTime;
     fa := FinddataW.dwFileAttributes;
   end
  else
   begin
     LARGE_Integer( Result ).LowPart := FindDataA.nFileSizeLow;
     LARGE_Integer( Result ).HighPart := FindDataA.nFileSizeHigh;
     LARGE_Integer( fs ).LowPart := FindDataA.nFileSizeLow;
     LARGE_Integer( fs ).HighPart := FindDataA.nFileSizeHigh;
     ft.dwLowDateTime  := FinddataA.ftLastWriteTime.dwLowDateTime;
     ft.dwHighDateTime := FinddataA.ftLastWriteTime.dwHighDateTime;
     fa := FinddataA.dwFileAttributes;
   end;
   
  Windows.FindClose( SearchHandle );
end;
function ForceDirectoriesW( Path: WideString; Attr: Word ): Boolean;
var
  E: EInOutError;
begin
  Result := TRUE;
  if Path = '' then begin
    E := EInOutError.Create( 'Unable to create directory' );
    E.ErrorCode := 3;
    raise E;
  end;
  Path := ClearSlash( Path );
  if DirectoryExistsW( Path ) then Exit;
  if ( Length( Path ) < 3 ) or DirectoryExistsw( Path )
    or ( ExtractFilePath( Path ) = Path ) then Exit; // avoid 'xyz:' problem.
  Result := ForceDirectoriesW( PrevDir( Path ), 0 ) and CreateDirectoryW( PWideChar( Path ), nil );
  if Result and ( Attr > 0 ) then SetFileAttributesW( PWideChar( Path ), Attr );
end;
function UppercaseW_( s:WideString ):Widestring;
begin
  Result := S;
  if Length( Result ) > 0 then
    CharUpperBuffW( PWideChar( Result ), Length( Result ) );
end;
//--------------------------------------------------------------------------------------------------
//-------------------End UniCode procedures---------------------------------------------------------
//--------------------------------------------------------------------------------------------------
//--------------------------------------------------------------------------------------------------
//-------------------Start Twidestringlist_-----------------------------------------------------------
//--------------------------------------------------------------------------------------------------
procedure TWideStringList_.AddString( s: WideString );
var i:Longword;
begin
 i := length( WStrings );
 Setlength( WStrings,i+1 );
 WStrings[ i ] := s;
 Count := i+1;
end;
procedure TWideStringList_.RemoveString( s: WideString );
var
  i: LongWord;
  f: Boolean;
begin
  f := FALSE;
  s := UpperCase( s );
  for i := Low( WStrings ) to High( WStrings ) do begin
    if isEqualW( UppercaseW_( WStrings[ i ] ), s ) then begin
      f := TRUE;
      Break;
    end;
  end;
  if f then begin
    WStrings[ i ] := WStrings[ High( WStrings ) ];
    WStrings[ High( WStrings ) ] := '';
    SetLength( WStrings, Length( WStrings ) - 1 );
    Dec( Count );
  end;
end;
Procedure TWideStringList_.Clear;
begin
 Setlength( WStrings,0 );
 Count := 0;
end;
Constructor TWideStringList_.Create;
begin
 clear;
end;
//--------------------------------------------------------------------------------------------------
//-------------------END Twidestringlist_-------------------------------------------------------------
//--------------------------------------------------------------------------------------------------
//--------------------------------------------------------------------------------------------------
//  Start common functions
//------------------------------------------------------------------------------------------------
function createfile_(lpFileName:Pwidechar; Access:Cardinal; Share:Cardinal;SecAttr:PSecurityattributes;
                     CreationDisposition:Cardinal;Flags:Cardinal;Temp:Cardinal) : integer;
begin
if isUnicode then
 Result := createfilew(lpFilename,access,share,SecAttr,Creationdisposition,flags,temp)
else
 Result := createfilea(PAnsichar( AnsiString(lpFilename)),access,share,SecAttr,Creationdisposition,flags,temp)
end;
function TSevenZip.AppendSlash( sDir: widestring ): widestring;
begin
  if ( sDir <> '' ) and ( sDir[ Length( sDir ) ] <> '' ) then
    Result := sDir + ''
  else
    Result := sDir;
end;
procedure TSevenZip.SetVolumeSize( const Value: Integer );
begin
// Shadow 27.11.2006
  if not FSFXCreate then
    FVolumeSize := Value
  else begin
    if ( Value > 0 ) and ( Value < FSFXOffset ) then
      FVolumeSize := FSFXOffset + 7
    else FVolumeSize := Value;
  end;
end;
procedure TSevenZip.SetSFXCreate( const Value: Boolean );
  function FileSizeW( fn: WideString ): DWORD;
  var
    f: Integer;
  begin
    Result := 0;
    f := CreateFile_( PwideChar( fn ), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0 );
    if f <= 0 then Exit;
    try
      Result := FileSeek( f, 0, soFromEnd );
    finally
      FileClose( f );
    end;
  end;
var
  s: Int64;
begin
// Shadow 27.11.2006
  FSFXCreate := FALSE;
  if Value then begin
    s := FileSizeW( FSFXModule );
    if ( s > 0 ) then begin // FileExists
      if ( ( FVolumeSize > 0 ) and ( FVolumeSize < s + 7 ) ) then FVolumeSize := s + 7;
      FSFXOffset := s;
      FSFXCreate := TRUE;
    end;
  end;
end;
function FileTimeToDateTime( const rFileTime: TFileTime; const Localize: Integer = 0 ): TDateTime;
var
  dOffset: Double;
  rWork: TFileTime;
begin
  // offset to or from local time
  if Localize > 0 then
    FileTimeToLocalFileTime( rFileTime, rWork )
  else if Localize < 0 then
    LocalFileTimeToFileTime( rFileTime, rWork )
  else begin
    rWork := rFileTime;
  end;
  dOffset := 0.0000001 * ( ( Int64( rWork.dwHighDateTime ) shl 32 ) or rWork.dwLowDateTime );
  dOffset := dOffset / ( 60 * 60 * 24 );
  Result := EncodeDate( 1601, 1, 1 ) + dOffset;
end;
procedure SortDWord( var A: array of DWord; iLo, iHi: DWord );
var
  Lo, Hi, Mid, T: DWord;
begin
    Lo := iLo;
    Hi := iHi;
    Mid := A[ ( Lo + Hi ) div 2 ];
    repeat
      while A[ Lo ] < Mid do Inc( Lo );
      while A[ Hi ] > Mid do Dec( Hi );
      if Lo <= Hi then
      begin
        T := A[ Lo ];
        A[ Lo ] := A[ Hi ];
        A[ Hi ] := T;
        Inc( Lo );
        if Hi > 0 then Dec( Hi ); //Using DWord and not Integers
      end;
    until Lo > Hi;
    if Hi > iLo then SortDWord( A, iLo, Hi );
    if Lo < iHi then SortDWord( A, Lo, iHi );
end;
function DriveIsRemovable( Drive: WideString ): Boolean;
var
  DT: Cardinal;
begin
  DT := GetDriveTypeW( PWideChar( Drive ) );
  Result := ( DT <> DRIVE_FIXED );
end;
function TryStrToInt_( const S: string; out Value: Integer ): Boolean;
var
   E: Integer;
begin
   Val( S, Value, E );
   Result := ( E = 0 );
end;
//------------------------------------------------------------------------------------------------
//  End common functions
//--------------------------------------------------------------------------------------------------
//--------------------------------------------------------------------------------------------------
//--------------------------------------------------------------------------------------------------
//-------------------Start SevenZip Interface -----------------------------------------------
//--------------------------------------------------------------------------------------------------
//--------------------------------------------------------------------------------------------------
function TInterfacedObject.QueryInterface( const IID: TGUID; out Obj ): HResult;
const
  E_NOINTERFACE = HResult( $80004002 );
begin
  if GetInterface( IID, Obj ) then
  begin
    Result := 0;
    Log( 'INTERFACEOK:' + ClassName + ' ' + GUIDToString( IID ) );
  end else
  begin
    Result := E_NOINTERFACE;
    Log( '  NOINTERFACE: ' + ClassName + ' ' + GUIDToString( IID ) );
  end;
end;
function TInterfacedObject._AddRef: Integer;
begin
  Result := InterlockedIncrement( FRefCount );
end;
function TInterfacedObject._Release: Integer;
begin
  Result := InterlockedDecrement( FRefCount );
  if Result = 0 then
    Destroy;
end;
procedure TInterfacedObject.AfterConstruction;
begin
// Release the constructor's implicit refcount
  InterlockedDecrement( FRefCount );
end;
procedure TInterfacedObject.BeforeDestruction;
begin
  //if RefCount <> 0 then Error( reInvalidPtr );
end;
// Set an implicit refcount so that refcounting
// during construction won't destroy the object.
class function TInterfacedObject.NewInstance: TObject;
begin
  Result := inherited NewInstance;
  TInterfacedObject( Result ).FRefCount := 1;
end;
constructor TMyArchiveUpdateCallback.Create( Owner: TSevenZip );
begin
  inherited Create;
  FSevenzip := Owner;
// Shadow 29.11.2006
  if Assigned( FSevenzip ) then
    FPassword := FSevenzip.Password
  else FPassword := '';
end;
function TMyArchiveUpdateCallback.GetUpdateItemInfo( index: DWORD;
  newData: PInteger; // 1 - new data, 0 - old data
  newProperties: PInteger; // 1 - new properties, 0 - old properties
  indexInArchive: PDWORD // -1 if there is no in archive, or if doesn't matter
  ): Integer; stdcall;
begin
//  Log( Format( 'TMyArchiveUpdateCallback.GetUpdateItemInfo( %d )', [ index ] ) );
  if newData <> nil then newData^ := 1;
  if newProperties <> nil then newProperties^ := 1;
  if indexInArchive <> nil then indexInArchive^ := DWORD( -1 );
  Result := S_OK;
end;
function TMyArchiveUpdateCallback.CryptoGetTextPassword2( passwordIsDefined: PInteger; var Password: PWideChar ): Integer;
begin
  if Length( FPassword ) > 0 then begin
    passwordIsDefined^ := Integer( Bool( TRUE ) );
    Password := SysAllocString( @FPassword[ 1 ] );
    Result := S_OK;
  end else begin
    passwordIsDefined^ := Integer( Bool( FALSE ) );
    Result := S_OK;
  end;
end;
function TMyArchiveUpdateCallback.GetProperty( index: DWORD; propID: PROPID; value: PPROPVARIANT ): Integer; stdcall;
var
  sz: WideString;
begin
  Log( Format( 'TMyArchiveUpdateCallback.GetProperty( %d, %s ( %d ), %.8x )', [ index, PropIDToString( propID ), propID, Integer( value ) ] ) );
  Result := S_OK;
  case propID of
    //kpidPath ( 3 ) VT_BSTR ( 8 )
    kpidPath:
    begin
      value^.vt := VT_BSTR;
//get relative path if wanted
      sz := Files[ index ];
      if rootdir <> '' then
      begin
        if Uppercasew_( copy( sz,1,length( rootdir ) ) ) = rootdir then
          delete( sz,1,length( rootdir ) );
      end;
//User set filename in archive if wanted
      if assigned( Fsevenzip.OnSetAddName ) then
        Fsevenzip.OnSetAddName( Fsevenzip, sz );
//remove drive / Include drive if wanted
      if sz[ 2 ] = ':' then
        begin
         if char( sz[ 1 ] ) in [ 'A'..'Z','a'..'z' ] then
           if ( AddIncludeDriveLetter in Fsevenzip.FAddOptions ) then //include
            delete( sz,2,1 )
           else
             delete( sz,1,3 );
        end;
//just store filename
      if ( AddStoreOnlyFilename in Fsevenzip.FAddOptions ) then
        sz := ExtractFileNameW( sz );
//rg 07.11.2006 StringToOleStr( )
      value^.bstrVal := Pwidechar( sz );
    end;
    //kpidAttributes ( 9 ) VT_UI4 ( 19 )
    kpidAttributes:
    begin
      value^.vt := VT_UI4;
      value^.ulVal := Files_Attr[ index ];//filegetattr( files[ index ] );
    end;
    kpidCreationTime:
    begin
      value^.vt := VT_FILETIME;
      value^.filetime.dwLowDateTime := 0;
      value^.filetime.dwHighDateTime := 0;
    end;
    //kpidLastWriteTime ( 12 ) VT_FILETIME ( 64 )
    kpidLastWriteTime:
    begin
      value^.vt := VT_FILETIME;
      value^.filetime.dwLowDateTime := Files_Date[ index ].dwLowDateTime;;
      value^.filetime.dwHighDateTime := Files_Date[ index ].dwHighDateTime;
    end;
    kpidIsFolder:
    begin
      value^.vt := VT_BOOL;
      value^.boolVal := ( Files_Attr[ index ] and faDirectory ) <> 0; //false
    end;
    kpidIsAnti:
    begin
      value^.vt := VT_BOOL;
      value^.boolVal := False;
    end;
    //kpidSize ( 7 ) VT_UI8 ( 21 )
    kpidSize:
    begin
      value^.vt := VT_UI8;
      value^.uhVal.QuadPart := Files_size[ index ];
    end;
  else
    Log( 'Asking for unknown property' );
    Result := S_FALSE;
  end;
end;
function TMyArchiveUpdateCallback.GetStream( index: DWORD; var inStream: ISequentialInStream ): Integer; stdcall;
begin
  Log( 'TMyArchiveUpdateCallback.GetStream' );
  Fprogressfile := files[ index ];
  Fprogressfilesize := files_size[ index ];
  Fprogressfilepos := 0;
  inStream := TMyStreamReader.Create( FSevenZip, Files[ index ], FALSE );
  Result := S_OK;
end;
function TMyArchiveUpdateCallback.SetOperationResult( operationResult: Integer ): Integer; stdcall;
begin
  Log( Format( 'TMyArchiveUpdateCallback.SetOperationResult( %d )', [ operationResult ] ) );
  Result := S_OK;
end;
function TMyArchiveUpdateCallback.SetTotal( total: Int64 ): Integer; stdcall;
begin
  Log( Format( 'TMyArchiveUpdateCallback.SetTotal( %d )', [ total ] ) );
  Result := S_OK;
end;
function TMyArchiveUpdateCallback.SetCompleted( const completeValue: PInt64 ): Integer; stdcall;
begin
/// Progressfile - Newfile
/// Do it here because it works with Multithreaded 7za interaction.
  Log( Format( 'TMyArchiveUpdateCallback.SetCompleted( %d )', [ completeValue^ ] ) );
//fileprogress
   if ( FProgressFilePos = 0 ) then
      if assigned( Fsevenzip.OnAddFile ) then Fsevenzip.onAddFile( Fsevenzip,FProgressFile,FProgressFileSize );
   FProgressFilePos := FProgressFilePos + ( completeValue^ - FLastPos );
   FLastPos := completeValue^;
//full and file progress position
   if assigned( Fsevenzip.OnProgress ) then Fsevenzip.OnProgress( Fsevenzip,FProgressFile,completeValue^,FProgressFilePos );
  Result := S_OK;
//rg 24.06
//User cancel operation
  if FSevenzip.FMainCancel then
   begin
     if assigned( Fsevenzip.onMessage ) then Fsevenzip.OnMessage( Fsevenzip,6,'User canceled operation',FProgressFile );
     Result := S_FALSE;
   end;
end;
constructor TMyArchiveExtractCallback.Create( Owner: TSevenZip );
begin
  inherited Create;
  FSevenzip := Owner;
// Shadow 29.11.2006
  if Assigned( FSevenzip ) then
    FPassword := FSevenzip.Password
  else FPassword := '';
end;
function TMyArchiveExtractCallback.GetStream( index: DWORD;
  out outStream: ISequentialOutStream; askExtractMode: DWORD ): Integer; stdcall;
var
 path: Propvariant;
 size: Propvariant;
 date: Propvariant;
 attr: Propvariant;
   sz, origName: Widestring;
   fe,DoOverwrite: boolean;
//   fHnd: Integer;
begin
  Log( Format( '__TMyArchiveExtractCallback.GetStream( %d, %.8x, %d )', [ index, Integer( outStream ), askExtractMode ] ) );
  path.vt := VT_EMPTY;
  size.vt := VT_EMPTY;
  date.vt := VT_EMPTY;
  attr.vt := VT_EMPTY;
//Cancel Operation
  if self.FSevenzip.FMainCancel then
   begin
    outStream := nil;
    result := S_FALSE;
    exit;
   end;
  Case askExtractMode of
    kExtract:  begin
                 FSevenzip.inA.GetProperty( index, kpidPath, path );
                 FSevenzip.inA.GetProperty( index, kpidSize, size );
                 FSevenzip.inA.GetProperty( index, kpidattributes, attr );
                 FSevenzip.inA.GetProperty( index, kpidLastWriteTime, date );
//rg 23.8.06
                 if ExtractNoPath in FSevenzip.FExtractOptions then
                   sz := FExtractDirectory + extractfilenameW( path.bstrVal )
                  else
                   sz := FExtractDirectory + path.bstrVal;
                 origName := sz;
                 if assigned( Fsevenzip.OnSetExtractName ) then
                   Fsevenzip.OnSetExtractName( Fsevenzip, sz );
                 if FileExists_( sz ) then
                   begin
                     if assigned( Fsevenzip.OnExtractOverwrite ) then
                         Fsevenzip.OnExtractOverwrite( Fsevenzip, sz,DoOverwrite );
                     if not DoOverwrite then
                      begin
                       Result := S_OK;
                       outStream := nil;
                       exit;
                      end;
                    end;
                    FProgressFile := sz;
                    FProgressFilePos := 0;
                    FprogressFileSize := size.uhVal.QuadPart;
                 if ( attr.uiVal and ( 1 shl 4 ) ) <> 0 then
                  begin
                   if isUnicode then
                     ForceDirectoriesW( sz, attr.uiVal )
                    else
                     ForceDirectories(String(sz));
                  end
                 else
                  begin
                    FFilestoextract := FFilestoextract - 1;
                    if FFilestoextract = 0 then FLastFileToExt := true;
                    outStream := nil;
                    fe := FileExists_( sz );
                    if ( not fe ) or ( fe and ( ( ExtractOverwrite in FsevenZip.FExtractOptions ) or DoOverwrite ) ) then begin
                      if isUnicode then
                        ForceDirectoriesW( ExtractFilePathW( sz ), attr.uiVal )
                       else
                        ForceDirectories(extractfilepath( String( sz ) ) );
                    try
                      outStream := TMyStreamWriter.Create( sz, FileTimeToDateTime( date.filetime, 2 ), attr.lVal );
                    except
                      outStream := nil;
                      Result := S_FALSE;
                      Exit;
// did not work here need another place !
// if assigned( FsevenZip.onmessage ) then FsevenZip.onmessage( FsevenZip, 2, 'Could not create file', origName );
                    end;
                  end;
              end;
             end;
    ktest   : begin
                 FSevenzip.inA.GetProperty( index, kpidPath, path );
                 FSevenzip.inA.GetProperty( index, kpidSize, size );
                 FProgressFile := path.bstrVal;
                 FProgressFilePos := 0;
                 FprogressFileSize := size.uhVal.QuadPart ;
               end;
    kskip   : begin
               end;
  end;
  Result := S_OK;
end;
// GetStream OUT: S_OK - OK, S_FALSE - skeep this file
function TMyArchiveExtractCallback.PrepareOperation( askExtractMode: Integer ): Integer; stdcall;
begin
  Log( Format( 'TMyArchiveExtractCallback.PrepareOperation( %d )', [ askExtractMode ] ) );
  Result := S_OK;
end;
function TMyArchiveExtractCallback.SetOperationResult( resultEOperationResult: Integer ): Integer; stdcall;
begin
  Result := S_OK;
  Log( Format( 'TMyArchiveExtractCallback.SetOperationResult( %d )', [ resultEOperationResult ] ) );
  case resultEOperationResult of
    kOK               : ;
    kUnSupportedMethod: if assigned( Fsevenzip.onmessage ) then Fsevenzip.onmessage( Fsevenzip,4,'Unsupported Method',FProgressFile );
    kDataError        : if assigned( Fsevenzip.onmessage ) then Fsevenzip.onmessage( Fsevenzip,2,'Data Error',FProgressFile );
    kCRCError         : if assigned( Fsevenzip.onmessage ) then Fsevenzip.onmessage( Fsevenzip,3,'CRC Error',FProgressFile );
  end;
  if FLastFileToExt then FAllFilesExt := true; //no more files to extract, we can stop
end;
function TMyArchiveExtractCallback.SetTotal( total: Int64 ): Integer; stdcall;
begin
  Log( Format( 'TMyArchiveExtractCallback.SetTotal( %d )', [ total ] ) );
//all filesizes also skipped ones
  if FFilestoextract = 0 then // we extract all files, so we set FMaxProgress here
     if assigned( FSevenzip.OnPreProgress ) then FSevenzip.OnPreProgress( FSevenzip,total );
  Result := S_OK;
end;
function TMyArchiveExtractCallback.SetCompleted( const completeValue: PInt64 ): Integer; stdcall;
begin
   if ( FProgressFilePos = 0 ) then
      if assigned( Fsevenzip.OnExtractFile ) then Fsevenzip.onExtractfile( Fsevenzip,FProgressFile,FProgressFileSize );
   FProgressFilePos := FProgressFilePos + ( completeValue^ - FLastPos );
   FLastPos := completeValue^;
//full and file progress position
   if assigned( Fsevenzip.OnProgress ) then Fsevenzip.OnProgress( Fsevenzip,FProgressFile,completeValue^,FProgressFilePos );
  Log( Format( 'TMyArchiveExtractCallback.SetCompleted( %d )', [ completeValue^ ] ) );
  Result := S_OK;
  //have all files extracted. Could stop
  //User cancel operation
  if self.FAllFilesExt then Result := S_FALSE;
  if  Fsevenzip.FMainCancel then begin
     Result := S_FALSE;
     if assigned( Fsevenzip.onMessage ) then Fsevenzip.OnMessage( Fsevenzip,6,'User canceled operation',FProgressFile );
   end;
end;
function TMyArchiveExtractCallback.CryptoGetTextPassword( var Password: PWideChar ): Integer;
begin
  if Length( FPassword ) > 0 then begin
    Password := SysAllocString( @FPassword[ 1 ] );
    Result := S_OK;
  end else Result := S_FALSE;
end;
{============ TMyOpenarchiveCallbackReader =================================================}
function TMyArchiveOpenCallback.CryptoGetTextPassword( var Password: PWideChar ): Integer;
begin
  if Length( FPassword ) > 0 then begin
    Password := SysAllocString( @FPassword[ 1 ] );
    Result := S_OK;
  end else Result := S_FALSE;
end;
constructor TMyArchiveOpenCallback.Create( Owner: TSevenZip );
begin
  inherited Create;
  FSevenzip := Owner;
// Shadow 29.11.2006
  if Assigned( FSevenzip ) then
    FPassword := FSevenzip.Password
  else FPassword := '';
end;
function TMyArchiveOpenCallback.SetTotal( const files: Int64; const bytes: Int64 ): Integer; stdcall;
begin
 // Lifepower (07-Jan-2007):
 //  Huh? Added some result value to prevent warning.
 Result:= 0;
//
end;
function TMyArchiveOpenCallback.SetCompleted( const files: Int64; const bytes: Int64 ): Integer; stdcall;
begin
 // Lifepower (07-Jan-2007):
 //  Added some result value to prevent warning.
 Result:= 0;
//
end;
{============ TMyStreamReader =================================================}
function TMyStreamReader.Seek( Offset: Int64; SeekOrigin: DWORD; NewPosition: PInt64 ): Integer; stdcall;
begin
//  frmMain.mmoLog.Lines.Add( '-> Seek ' + IntToStr( offset ) + ' ' + IntToStr( seekOrigin ) );
  Result := S_OK;
  case SeekOrigin of
    soFromBeginning: arcPosition := Offset;
    soFromCurrent: arcPosition := arcPosition + Offset;
    soFromEnd: begin
      if arcSize > 0 then
        arcPosition := arcSize + Offset
      else Result := S_FALSE;
    end;
  end;
  if newPosition <> nil then newPosition^ := arcPosition;
end;
function TMyStreamReader.Read( var Data; Size: DWORD; ProcessedSize: PDWORD ): Integer; stdcall;
var
  fIdx: Integer;
  fPos, pSize, Read: DWORD;
  Buff: PChar;
begin
  //frmMain.mmoLog.Lines.Add( '-> Read ' + Format( '%.8x', [ Integer( data ) ] ) + ' ' + IntToStr( size ) );
  if FArchive then begin
    if ( Length( Files ) <= 1 ) and ( arcPosition + Size > Files[ 0 ].Size ) then begin
      arcSize := arcPosition + Size;
      if not OpenLastVolume then begin
        Result := S_FALSE;
        Exit;
      end else FMultivolume := TRUE;
    end;
  end;
  if ( not FArchive ) or ( not FMultivolume ) then begin
    FileSeek( Files[ 0 ].Handle, arcPosition, soFromBeginning );
    if not ReadFile( Files[ 0 ].Handle, Data, Size, pSize, nil ) then pSize := 0;
    Inc( arcPosition, pSize );
    if ProcessedSize <> nil then ProcessedSize^ := pSize;
    Result := S_OK;
    Exit;
  end;
  fIdx := -1;
  pSize := 0;
  repeat
    Inc( fIdx );
    if ( Files[ fIdx ].Handle < 0 ) and ( not OpenVolume( fIdx + 1 ) ) then begin
      Result := S_FALSE;
      Exit;
    end;
    pSize := pSize + Files[ fIdx ].Size;
  until arcPosition < pSize;
  Buff := @Data;
  fPos := arcPosition - ( pSize - Files[ fIdx ].Size );
  Read := 0;
  while Read < Size do begin
    if Read > 0 then begin
      with Files[ fIdx - 1 ] do begin
        FileClose( Handle );
        Handle := -1;
        Size := 0;
      end;
      if ( Files[ fIdx ].Handle < 0 ) and ( not OpenVolume( fIdx + 1 ) ) then begin
        Result := S_FALSE;
        Exit;
      end;
    end;
    FileSeek( Files[ fIdx ].Handle, fPos, soFromBeginning );
    pSize := Size - Read;
    if Files[ fIdx ].Size < fPos + pSize then pSize := Files[ fIdx ].Size - fPos;
    if not ReadFile( Files[ fIdx ].Handle, Buff[ Read ], pSize, pSize, nil ) then begin
      Read := 0;
      Break;
    end;
    Inc( Read, pSize );
    Inc( fIdx );
    fPos := 0;
  end;
  Inc( arcPosition, Read );
  if Assigned( ProcessedSize ) then ProcessedSize^ := Read;
  Result := S_OK;
end;
function TMyStreamReader.ReadPart( var data; size: DWORD; processedSize: PDWORD ): Integer; stdcall;
begin
  //frmMain.mmoLog.Lines.Add( '-> ReadPart ' + IntToStr( size ) );
  Result := Read( Data, Size, ProcessedSize );
end;
function TMyStreamReader.GetSize( var size: Int64 ): Integer; stdcall;
begin
  //frmMain.mmoLog.Lines.Add( 'GetSize' );
  if arcSize > 0 then begin
    Size := arcSize;
    Result := S_OK;
  end else Result := S_FALSE;
end;
function TMyStreamReader.BrowseForFile( Title: PWideChar; var Name: WideString ): Boolean;
var
  OpenFileName: TOpenFilenameW;
  FileName: array[ 0..MAX_PATH - 1 ] of WideChar;
  s: WideString;
begin
  Result := FALSE;
  try
    s := ExtractFileNameW( Name );
    s := Copy( s, 1, Length( s ) - Length( ExtractFileExtW( Name ) ) );
    s := s + '-volumes'#0 + s + '.*'#0;
    FillChar( FileName, MAX_PATH, 0 );
    FillChar( OpenFileName, SizeOf( OpenFileName ), 0 );
    OpenFileName.lStructSize := SizeOf( OpenFileName );
    OpenFileName.hWndOwner := Application.Handle;
    OpenFileName.lpstrInitialDir := PWideChar( ExtractFilePathW( Name ) );
    OpenFileName.lpstrFile := @FileName;
    OpenFileName.nMaxFile := MAX_PATH;
    OpenFileName.lpstrFilter := @s[ 1 ];
    OpenFileName.nFilterIndex := 1;
    OpenFileName.Flags := OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST;
    if GetOpenFileNameW( OpenFileName ) then begin
      Name := FileName;
      Result := ( GetLastError = 0 );
    end else Result := FALSE;
  except
  end;
end;
function TMyStreamReader.OpenVolume( Index: Integer ): Boolean;
var
  i: Integer;
  s: WideString;
  fCancel: Boolean;
begin
  Result := FALSE;
  if Index <= 0 then
    Exit
  else if Index <= Length( Files ) then begin
    if Files[ Index - 1 ].Handle > 0 then begin
      Result := TRUE;
      Exit;
    end;
  end else begin
    i := Length( Files );
    while i < Index do begin
      SetLength( Files, i + 1 );
      Files[ i ].Handle := -1;
      Files[ i ].Size := 0;
      Inc( i );
    end;
  end;
  Dec( Index );
  if Length( Files[ Index ].Name ) <= 0 then begin
    s := IntToStr( Index + 1 );
    while Length( s ) < 3 do s := '0' + s;
// Shadow 28.11.2006
    if Assigned( FSevenZip ) and FSevenZip.IsSFX then begin
      Files[ Index ].Name := arcName + '.' + s
    end else Files[ Index ].Name := Copy( arcName, 1, Length( arcName ) - Length( ExtractFileExtW( arcName ) ) ) + '.' + s;
  end;
  while Files[ Index ].Handle <= 0 do begin
    Files[ Index ].Handle := CreateFile_( PwideChar( Files[ Index ].Name ), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0 );
    if Files[ Index ].Handle <= 0 then begin
      if Assigned( FOnOpenVolume ) then begin
        FOnOpenVolume( Files[ Index ].Name, Files[ Index ].OnRemovableDrive, fCancel );
        if not fCancel then Continue;
      end else begin
        if BrowseForFile( 'Select volume', Files[ Index ].Name ) then Continue;
      end;
      Files[ Index ].Name := '';
      Result := FALSE;
      Exit;
    end;
    Files[ Index ].Size := FileSeek( Files[ Index ].Handle, 0, soFromEnd );
    FileSeek( Files[ Index ].Handle, 0, soFromBeginning );
  end;
  Result := ( Files[ Index ].Size > 0 );
end;
function TMyStreamReader.OpenNextVolume: Boolean;
begin
  Result := OpenVolume( Length( Files ) + 1 );
end;
function TMyStreamReader.OpenLastVolume: Boolean;
var
  Name: WideString;
  n: Integer;
  function GetLastVolumeFN(first:widestring):widestring;
  var n:integer;
      s,e,lastfound:widestring;
  begin
    Result := '';
    s:= ChangeFileExtW( first,'');
    lastfound := first;
    if not TryStrToInt_( Copy( ExtractFileExtW( first ), 2, MaxInt ), n) then exit;
    e:= '00' + inttostr(n);
    repeat
      lastfound := s + '.' + e;
      inc(n);
      e:= inttostr(n);
      while Length( e ) < 3 do e := '0' + e;
    until not fileexists_( s + '.' + e);
    Result := lastfound;
  end;
begin
  Result := FALSE;
  repeat
{
    if Assigned( FOnOpenVolume ) then begin
      Name := ChangeFileExtW( Files[ 0 ].Name, '.*' );
      FOnOpenVolume( Name, Files[ 0 ].OnRemovableDrive, Result );
      if Result then begin
        Result := FALSE;
        Exit;
      end;
    end else begin
      Name := arcName;
      if not BrowseForFile( 'Select last volume', Name ) then Exit;
    end;
}
   name := '';
   name := GetLastVolumeFN(Arcname);
   if name = '' then
    if not BrowseForFile( 'Select last volume', Name ) then Exit;
// Shadow 28.11.2006
    if Assigned( FSevenZip ) and FSevenZip.IsSFX then begin
      if UpperCaseW_( ChangeFileExtW( ExtractFileNameW( Name ), '' ) ) <>
         UpperCaseW_( ExtractFileNameW( Files[ 0 ].Name ) ) then Continue;
    end else begin
      if UpperCaseW_( ChangeFileExtW( ExtractFileNameW( Name ), ExtractFileExtW( Files[ 0 ].Name ) ) ) <>
         UpperCaseW_( ExtractFileNameW( Files[ 0 ].Name ) ) then Continue;
    end;
    if not TryStrToInt_( Copy( ExtractFileExtW( Name ), 2, MaxInt ), n ) then Continue;
  until n > 1;
  Result := OpenVolume( n );
end;
constructor TMyStreamReader.Create( Owner: TSevenZip; sz: Widestring; asArchive: Boolean );
begin
  inherited Create;
  arcName := sz;
  arcPosition := 0;
  FSevenZip := Owner;
  if Assigned( FSevenZip ) then begin
    if Owner.IsSFX then arcPosition := Owner.SFXOffset;
    FOnOpenVolume := FSevenZip.FOnOpenVolume;
  end else FOnOpenVolume := nil;
  FArchive := asArchive;
  FMultivolume := FALSE;
  SetLength( Files, 1 );
  Files[ 0 ].Name := arcName;
  Files[ 0 ].Handle := CreateFile_( PWideChar( Files[ 0 ].Name ), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0 );
  Files[ 0 ].Size := FileSeek( Files[ 0 ].Handle, 0, soFromEnd );
  Files[ 0 ].OnRemovableDrive := DriveIsRemovable( Copy( ExtractFilePathW( Files[ 0 ].Name ), 1, 2 ) );
  if not FArchive then
    arcSize := Files[ 0 ].Size
  else arcSize := 0;
//  frmMain.mmoLog.Lines.Add( IntToStr( fIn ) );
end;
destructor TMyStreamReader.Destroy;
var
  i: Integer;
begin
  for i := 0 to Length( Files ) - 1 do if Files[ i ].Handle > 0 then FileClose( Files[ i ].Handle );
  SetLength( Files, 0 );
  Log( 'TMyStreamReader.Destroy' );
  inherited;
end;
{============ TMyStreamWriter =================================================}
function TMyStreamWriter.Write( const Data; Size: DWORD; ProcessedSize: PDWORD ): Integer; stdcall;
var
  fIdx: Integer;
  fPos, pSize, Written: DWORD;
  Buff: PChar;
begin
  Log( Format( '-> Write( %.8x, %d )', [ Integer( data ), size ] ) );
  if arcVolumeSize > 0 then begin
    fIdx := ( arcPosition + Size ) div arcVolumeSize;
    while Length( Files ) < Integer( Succ( fIdx ) ) do CreateNewFile;
    fIdx := arcPosition div arcVolumeSize;
    fPos := arcPosition mod arcVolumeSize;
    Buff := @Data;
    Written := 0;
    while Written < Size do begin
      FileSeek( Files[ fIdx ].Handle, fPos, soFromBeginning );
      pSize := Size - Written;
      if arcVolumeSize < fPos + pSize then pSize := arcVolumeSize - fPos;
      if not WriteFile( Files[ fIdx ].Handle, Buff[ Written ], pSize, pSize, nil ) then begin
        Written := 0;
        Break;
      end;
      Inc( Written, pSize );
      Inc( fIdx );
      fPos := 0;
    end;
  end else begin
    FileSeek( Files[ 0 ].Handle, arcPosition, soFromBeginning );
    if not WriteFile( Files[ 0 ].Handle, Data, Size, Written, nil ) then Written := 0;
  end;
  Inc( arcPosition, Written );
  if arcPosition > arcSize then arcSize := arcPosition;
  if Assigned( ProcessedSize ) then ProcessedSize^ := Written;
  Result := S_OK;
end;
function TMyStreamWriter.WritePart( const Data; Size: DWORD; ProcessedSize: PDWORD ): Integer; stdcall;
begin
  Result := Write( Data, Size, ProcessedSize );
end;
function TMyStreamWriter.Seek( Offset: Int64; SeekOrigin: DWORD; NewPosition: PInt64 ): Integer; stdcall;
begin
  Log( Format( 'TMyStreamWriter.Seek( %d, %d, %.8x )', [ offset, seekOrigin, Integer( newPosition ) ] ) );
  case SeekOrigin of
    soFromBeginning: arcPosition := Offset;
    soFromCurrent: arcPosition := arcPosition + Offset;
    soFromEnd: arcPosition := arcSize + Offset;
  end;
  if arcPosition > arcSize then arcSize := arcPosition;
  if newPosition <> nil then newPosition^ := arcPosition;
  Result := S_OK;
end;
function TMyStreamWriter.SetSize( newSize: Int64 ): Integer; stdcall;
begin
  Log( Format( 'TMyStreamWriter.SetSize( %d )', [ newSize ] ) );
  Result := S_FALSE;
end;
destructor TMyStreamWriter.Destroy;
var
  i: Integer;
begin
  for i := Low( Files ) to High( Files ) do FileClose( Files[ i ].Handle );
  Log( 'TMyStreamWriter.Destroy' );
  inherited;
end;
function TMyStreamWriter.CreateNewFile: Boolean;
var
  i: Integer;
  s: WideString;
begin
  i := Length( Files );
  SetLength( Files, i + 1 );
  if arcVolumeSize > 0 then begin
    s := IntToStr( i + 1 );
    while Length( s ) < 3 do s := '0' + s;
    s := arcName + '.' + s;
  end else s := arcName;
  if arcCreateSFX and ( i = 0 ) then begin
// Shadow 27.11.2006
    Files[ 0 ].Handle := CreateFile_( PwideChar( arcName ), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, arcAttr, 0 );
    if Files[ 0 ].Handle > 0 then arcPosition := FileSeek( Files[ 0 ].Handle, 0, soFromEnd );
  end else
    Files[ i ].Handle := CreateFile_( PwideChar( s ), GENERIC_READ or GENERIC_WRITE, 0, nil, CREATE_ALWAYS, arcAttr, 0 );
  if Files[ i ].Handle <= 0 then Abort;
  FileSetDate( Files[ i ].Handle, DateTimeToFileDate( arcDate ) );
  Result := TRUE;
end;
constructor TMyStreamWriter.Create( sz: Widestring; szDate: Tdatetime; FAttr: Cardinal; VolumeSize: Integer; CreateSFX: Boolean );
begin
  inherited Create;
  arcName := sz;
  arcDate := szDate;
  arcAttr := FAttr;
  arcCreateSFX := CreateSFX;
  arcVolumeSize := VolumeSize;
  arcPosition := 0;
  arcSize := 0;
  SetLength( Files, 0 );
  if not CreateNewFile then Abort;
end;
// ------------------------------------------------------------------------------------------
//functions for SevenZip
function PropIDToString( propID: Integer ): string;
begin
  case propID of
    kpidNoProperty       : Result := 'kpidNoProperty';
    kpidHandlerItemIndex : Result := 'kpidHandlerItemIndex';
    kpidPath             : Result := 'kpidPath';
    kpidName             : Result := 'kpidName';
    kpidExtension        : Result := 'kpidExtension';
    kpidIsFolder         : Result := 'kpidIsFolder';
    kpidSize             : Result := 'kpidSize';
    kpidPackedSize       : Result := 'kpidPackedSize';
    kpidAttributes       : Result := 'kpidAttributes';
    kpidCreationTime     : Result := 'kpidCreationTime';
    kpidLastAccessTime   : Result := 'kpidLastAccessTime';
    kpidLastWriteTime    : Result := 'kpidLastWriteTime';
    kpidSolid            : Result := 'kpidSolid';
    kpidCommented        : Result := 'kpidCommented';
    kpidEncrypted        : Result := 'kpidEncrypted';
    kpidSplitBefore      : Result := 'kpidSplitBefore';
    kpidSplitAfter       : Result := 'kpidSplitAfter';
    kpidDictionarySize   : Result := 'kpidDictionarySize';
    kpidCRC              : Result := 'kpidCRC';
    kpidType             : Result := 'kpidType';
    kpidIsAnti           : Result := 'kpidIsAnti';
    kpidMethod           : Result := 'kpidMethod';
    kpidHostOS           : Result := 'kpidHostOS';
    kpidFileSystem       : Result := 'kpidFileSystem';
    kpidUser             : Result := 'kpidUser';
    kpidGroup            : Result := 'kpidGroup';
    kpidBlock            : Result := 'kpidBlock';
    kpidComment          : Result := 'kpidComment';
    kpidPosition         : Result := 'kpidPosition';
    kpidTotalSize        : Result := 'kpidTotalSize';
    kpidFreeSpace        : Result := 'kpidFreeSpace';
    kpidClusterSize      : Result := 'kpidClusterSize';
    kpidVolumeName       : Result := 'kpidVolumeName';
    kpidLocalName        : Result := 'kpidLocalName';
    kpidProvider         : Result := 'kpidProvider';
    kpidUserDefined      : Result := 'kpidUserDefined';
  else
    Result := 'unknown';
  end;
end;
function PropTypeToString( propType: Integer ): string;
begin
  case propType of
    VT_EMPTY          : Result := 'VT_EMPTY';
    VT_NULL           : Result := 'VT_NULL';
    VT_I2             : Result := 'VT_I2';
    VT_I4             : Result := 'VT_I4';
    VT_R4             : Result := 'VT_R4';
    VT_R8             : Result := 'VT_R8';
    VT_CY             : Result := 'VT_CY';
    VT_DATE           : Result := 'VT_DATE';
    VT_BSTR           : Result := 'VT_BSTR';
    VT_DISPATCH       : Result := 'VT_DISPATCH';
    VT_ERROR          : Result := 'VT_ERROR';
    VT_BOOL           : Result := 'VT_BOOL';
    VT_VARIANT        : Result := 'VT_VARIANT';
    VT_UNKNOWN        : Result := 'VT_UNKNOWN';
    VT_DECIMAL        : Result := 'VT_DECIMAL';
    VT_I1             : Result := 'VT_I1';
    VT_UI1            : Result := 'VT_UI1';
    VT_UI2            : Result := 'VT_UI2';
    VT_UI4            : Result := 'VT_UI4';
    VT_I8             : Result := 'VT_I8';
    VT_UI8            : Result := 'VT_UI8';
    VT_INT            : Result := 'VT_INT';
    VT_UINT           : Result := 'VT_UINT';
    VT_VOID           : Result := 'VT_VOID';
    VT_HRESULT        : Result := 'VT_HRESULT';
    VT_PTR            : Result := 'VT_PTR';
    VT_SAFEARRAY      : Result := 'VT_SAFEARRAY';
    VT_CARRAY         : Result := 'VT_CARRAY';
    VT_USERDEFINED    : Result := 'VT_USERDEFINED';
    VT_LPSTR          : Result := 'VT_LPSTR';
    VT_LPWSTR         : Result := 'VT_LPWSTR';
    VT_FILETIME       : Result := 'VT_FILETIME';
    VT_BLOB           : Result := 'VT_BLOB';
    VT_STREAM         : Result := 'VT_STREAM';
    VT_STORAGE        : Result := 'VT_STORAGE';
    VT_STREAMED_OBJECT: Result := 'VT_STREAMED_OBJECT';
    VT_STORED_OBJECT  : Result := 'VT_STORED_OBJECT';
    VT_BLOB_OBJECT    : Result := 'VT_BLOB_OBJECT';
    VT_CF             : Result := 'VT_CF';
    VT_CLSID          : Result := 'VT_CLSID';
  else
    Result := 'Unknown';
  end;
end;
//--------------------------------------------------------------------------------------------------
//--------------------------------------------------------------------------------------------------
//-------------------End SevenZip Interface -------------------------------------------------
//--------------------------------------------------------------------------------------------------
//--------------------------------------------------------------------------------------------------
//--------------------------------------------------------------------------------------------------
//-----------------START DEBUG ONLY-----------------------------------------------------------------
//--------------------------------------------------------------------------------------------------
// For Debug only
// Add this to your MainForm public
{
 procedure LogMessage( var msg: TMessage ); message 9999;
}
{
  procedure TForm1.SevenZip1Message( Sender: TObject; ErrCode: Integer; Message: String );
  begin
   memo1.lines.add( message );
  end;
}
// and to Form.Activate this ( or set it when you want with e.g. a Button )
{
 sevenzipvcl.FMainhandle := form1.Handle;
}
procedure Log( sz: string );
var
  p: PString;
begin
  p := new( PString );
  p^ := sz;
  PostMessage( fMainhandle, 9999, 0, Integer( p ) );
end;
//--------------------------------------------------------------------------------------------------
//-----------------END DEBUG ONLY-------------------------------------------------------------------
//--------------------------------------------------------------------------------------------------
//------------------------------------------------------------------------------------------------
//------------------------------------------------------------------------------------------------
//-----------------Start SevenZip VCL-------------------------------------------------------
//------------------------------------------------------------------------------------------------
//------------------------------------------------------------------------------------------------
//constructor destructor
//------------------------------------------------------------------------------------------------
(*
procedure TSevenZip.LogMessage( var msg: TMessage );
begin
  if assigned( onMessage ) then OnMessage( Self,0,PString( msg.LParam )^ );
  Dispose( PString( msg.LParam ) );
end;
*)
constructor TSevenZip.Create( AOwner: TComponent );
var OSVerInfo : TOSVersionInfo;
{$IFDEF UseRes7zdll}
  MemoryStream: TResourceStream;
{$ENDIF}
begin
  inherited Create( AOwner );
  ffiles := TWideStringList_.Create;
  ResetCancel;
  FMainHandle := FHandle;
  FNumberOfFiles := -1;
  FPassword := '';
  FSFXModule := '7z.sfx';
// Shadow 28.11.2006
  FCreateObject := nil;
  F7zaLibh := LoadLibrary( '7za.dll' );
{$IFDEF Use7zdll}
  if F7zaLibh > 0 then
    @FCreateObject := GetProcAddress( F7zaLibh, 'CreateObject' );
{$ENDIF}
{$IFDEF UseRes7zdll}
    MemoryStream := TResourceStream.Create( HInstance, '7zip_library', RT_RCDATA );
    try
      m_DllDataSize := MemoryStream.Size;
      mp_DllData := GetMemory( m_DllDataSize );
      MemoryStream.Read( mp_DllData^, m_DllDataSize );
    finally
      MemoryStream.Free;
    end;
    mp_MemoryModule := BTMemoryLoadLibary( mp_DllData, m_DllDataSize );
    @FCreateObject := BTMemoryGetProcAddress( mp_MemoryModule, 'CreateObject' );
{$ENDIF}
  if not Assigned( FCreateObject ) then begin
    raise Exception.Create( 'Could not load CreateObject function from 7za.dll' + #13#10 + 'Perhaps 7za.dll not found' );
  end else begin
    FCreateObject( @CLSID_CFormat7z, @IID_IInArchive, inA );
    FCreateObject( @CLSID_CFormat7z, @IID_IOutArchive, outA );
    FCreateObject( @CLSID_CFormat7z, @IID_ISetProperties, sp );
  end;
  OSVerInfo.dwOSVersionInfoSize := sizeof(OSVerInfo);
  GetVersionEx(OsVerInfo);
  if osverinfo.dwPlatformID = VER_PLATFORM_WIN32_WINDOWS then
   isUnicode := false
  else
   isUnicode := true;
end;
destructor TSevenzip.Destroy;
begin
//jjw 18.10.2006
  inA := nil;
  outA := nil;
  sp := nil;
  if F7zaLibh > 0 then FreeLibrary( F7zaLibh );
{$IFDEF UseRes7zdll}
  if m_DllDataSize > 0 then FreeMemory( mp_DllData );
  if mp_MemoryModule <> nil then BTMemoryFreeLibrary( mp_MemoryModule );
{$ENDIF}
  
  ffiles.Clear;
  ffiles.Free;
  inherited;
end;
//------------------------------------------------------------------------------------------------
//End constructor destructor
//------------------------------------------------------------------------------------------------
Procedure TSevenZip.Cancel; // public
begin
 FMainCancel := True;
end;
Procedure TSevenZip.ResetCancel; // private
begin
 FMainCancel := False;
end;
//RG 02.06.2006
function TSevenZip.GetIndexByFilename( FileToExtract: Widestring ): Integer;
var
  n: Integer;
  w: DWORD;
  fnameprop: PROPVARIANT;
  fileInArchive: widestring;
  ms: TMyStreamReader;
begin
  try
    Result := -1;
    ms := TMyStreamReader.Create( Self, FSevenZipFileName, TRUE );
    inA.Close;
    inA.Open( ms, nil, nil );
    inA.GetNumberOfItems( w ); //1..end
    FileToExtract := UppercaseW_( FileToExtract );
    for n := 0 to w-1 do begin
      fnameprop.vt := VT_EMPTY;
      inA.GetProperty( n, kpidPath, fnameprop );
      fileInArchive := UppercaseW_( OleStrToString( fnameprop.bstrVal ) );
      if ( fileInArchive = FileToExtract ) then begin
        Result := n;
        Break;
      end;
    end;
  finally
    inA.close;
  end
end;
//-------------------------------------------------------
//SFX functions
// Shadow 28.11.2006
function TSevenZip.SFXCheck( Fn: WideString ): Boolean;
const
  ID_7z: Array[ 0..5 ] of byte = ( 55, 122, 188, 175, 39, 28 );
var
  MySize, MyOrigSize: DWORD;
  Source: Integer;
  Buffer: array[ 0..81919 ] of Byte;
  ReadBytes, i: DWORD;
  function MyOriginalSize: DWORD;
  var
    s, d: DWORD;
    w: Word;
  begin
    Result := 0;
    s := FileSeek( Source, 0, soFromCurrent );
    try
      FileSeek( Source, $3C, soFromBeginning );
      FileRead( Source, d, 4 );
      FileSeek( Source, d + $06, soFromBeginning );
      FileRead( Source, w, 2 );
{?????????????}
      Inc( w );
{?????????????}
      FileSeek( Source, ( d + $F8 ) + ( w * $28 ) - $14 , soFromBeginning );
      FileRead( Source, Result, 4 );
    finally
      FileSeek( Source, s, soFromBeginning );
    end;
  end;
  function CheckSignature( Offset: Integer ): Boolean;
  var
    i: Integer;
  begin
    Result := FALSE;
    for i := 0 to 5 do begin
      if ( Buffer[ Offset + i ] <> ID_7z[ i ] ) then Break;
      if i = 5 then Result := TRUE;
    end;
  end;
begin
  Result := FALSE;
  if UpperCaseW_( ExtractFileExtW( Fn ) ) <> '.EXE' then Exit;
  FSFXoffset := 0;
  FIsSFX := FALSE;
  Source := CreateFile_( PWideChar( Fn ), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0 );
  try
    MySize := FileSeek( Source, 0, soFromEnd );
    FileSeek( Source, 65536, soFromBeginning );
    ReadFile( Source, Buffer[ 0 ], SizeOf( Buffer ), ReadBytes, nil );
    for i := 0 to ReadBytes - 6 do begin
      FIsSFX := CheckSignature( i );
      if FIsSFX then begin
        FSFXOffset := 65536 + i;
        Result := TRUE;
        Break;
      end;
    end;
    if not FIsSFX then begin
      MyOrigSize := MyOriginalSize;
      if MySize <> MyOrigSize then begin
        FileSeek( Source, MyOrigSize, soFromBeginning );
        ReadFile( Source, Buffer[ 0 ], 6, ReadBytes, nil );
        FIsSFX := CheckSignature( 0 );
        if FIsSFX then begin
          FSFXOffset := MyOrigSize;
          Result := TRUE;
        end;
      end;
    end;
  finally
    FileClose( Source );
  end;
end;
function TSevenZip.ConvertSFXto7z( Fn:Widestring ): boolean;
var Source,Dest: Integer;
    DestFn: Widestring;
    buffer: pointer;
    readbytes,writebytes:Dword;
const
    chunksize = 1024*128;
begin
  //ErikGG Begin 08.11.06
  Buffer := Nil;
  Source := -1;
  Dest := -1;
  // Lifepower (07-Jan-2007):
  //  Commented unused value assignment.
  //Result := False;
  //ErikGG End 08.11.06
  try
    DestFn := changefileextW( Fn,'.7z' );
     Source := CreateFile_( PwideChar( Fn ), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0 );
    Fileseek( Source,SFXoffset,0 ); //goto 7z data
    Dest := CreateFile_( PwideChar( DestFn ), GENERIC_WRITE, 0, nil, CREATE_ALWAYS, 0, 0 );
    GetMem( Buffer,chunksize ); { allocate the buffer }
    repeat
      readbytes := Fileread( Source,buffer^,chunksize );
      writebytes := Filewrite( Dest,buffer^,readbytes );
    until readbytes < chunksize;
    if writebytes = 0 then;
    //ErikGG 08.11.06
    Result := true;//Only reached if no error happend
  finally
    //ErikGG Begin 07.11.06
    if Buffer <> Nil then freemem( buffer );
    if Source <> 0 then   Fileclose( Source );
    if Dest <> 0 then     Fileclose( Dest );
    //ErikGG End 07.11.06
  end;
end;
function TSevenZip.Convert7ztoSFX( Fn:Widestring ): boolean;
var Source,Dest: Integer;
    DestFn: Widestring;
    buffer: pointer;
    readbytes,writebytes:Dword;
const
    chunksize = 1024*128;
begin
 //ErikGG Begin 07.11.06
 Result := false;
 Buffer := Nil;
 Source := -1;
 Dest := -1;
 //ErikGG End 07.11.06
 DestFn := changefileextW( Fn,'.exe' );
 if not copyfilew( PWidechar( sfxmodule ),PWideChar( DestFn ),True ) then
  begin
   if assigned( onMessage ) then onMessage( self,8,'SFXModule error ( Not found )',Fsevenzipfilename );
   exit;
  end;
try
  Source := CreateFile_( PwideChar( Fn ), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0 );
  Dest := CreateFile_( PwideChar( DestFn ), GENERIC_Write, 0, nil, OPEN_EXISTING, 0, 0 );
  fileseek( Dest,0,2 );
  GetMem( Buffer,chunksize ); { allocate the buffer }
  repeat
    readbytes := Fileread( Source,buffer^,chunksize );
    writebytes := Filewrite( Dest,buffer^,readbytes );
  until readbytes < chunksize;
  if writebytes = 0 then;
  //ErikGG 07.11.06
  Result := true;//Only reached if no error happend
finally
 if Buffer <> Nil then freemem( buffer );
 if Source <> 0 then   Fileclose( Source );
 if Dest <> 0 then     Fileclose( Dest );
 //ErikGG End 07.11.06
end;
end;
//SFX functions end
//-------------------------------------------------------
function TSevenZip.List: Integer;
var
  ms: TMyStreamReader;
  updateOpenCallback: TmyArchiveOpenCallback;
  i: Integer;
  w: DWord;
  name: TBSTR;
  prop: PROPID;
  pType: Integer;
  path: PROPVARIANT;
  size: PROPVARIANT;
  packedsize: PROPVARIANT;
  attr:PROPVARIANT;
  fcrc: PROPVARIANT;
  szMethod: PROPVARIANT;
  sztime: PROPVARIANT;
  szMethod_WS: Widestring;
  blockpid: PROPVARIANT;
begin
  try
    Ffiles.Clear;
    FNumberOfFiles := -1;
    if UppercaseW_( ExtractFileExtW( FSevenZipFileName ) ) = '.EXE' then begin
      if not SFXCheck( FSevenZipFileName ) then begin
        Result := -1;
        if assigned( onMessage ) then onMessage( self,7,'File is not an 7z SFX archive',Fsevenzipfilename );
        Exit;
      end;
    end;
    ms := TMyStreamReader.Create( Self, FSevenZipFileName, TRUE );
    inA.Close;
// 24.08.06 - Matteo Riso - Status: experimental
// 25.08.06 Modified by rg
//
// If we loaded an .EXE file, we could start reading from offset 132096.
// Also supported by newerdll
//  if FIsSFX then ms.Seek( FSFXOffset,0,@FSFXOffset );
// End - MR modification
    updateOpenCallback := TMyArchiveOpenCallback.Create( self );
    i := inA.Open(ms, nil,updateOpencallback );
  if i <> 0 then
   begin
     Result := -1;
     if assigned( onMessage ) then onMessage( self,1,'File not found',Fsevenzipfilename );
     Exit;
   end;
(*
   inA.GetNumberOfArchiveProperties( w );
   for i := 0 to w-1 do
    begin
     path.vt := VT_EMPTY;
     ina.GetArchiveProperty( kpidPath,@path );
     if assigned( onMessage ) then onMessage( self,i,path.bstrVal,path.pwszVal );
    end;
*)
  inA.GetNumberOfProperties( w );
  for i := 0 to w - 1 do
  begin
    name := new( TBSTR );
    ptype := 0;
    inA.GetPropertyInfo( i, name, prop, pType );
    if name = nil then
    begin
      Log( Format( '%d %s %s ( %d ) %s ( %d )', [ i, '', PropIDToString( prop ), prop, PropTypeToString( pType ), pType ] ) )
    end else
    begin
      log( Format( '%d %s %s ( %d ) %s ( %d )', [ i, name, PropIDToString( prop ), prop, PropTypeToString( pType ), pType ] ) );
    end;
  end;
  inA.GetNumberOfItems( w );
  FNumberOfFiles := w;
  for i := 0 to w-1 do
   begin
       path.vt := VT_EMPTY;
       size.vt := VT_EMPTY;
       packedsize.vt := VT_EMPTY;
       attr.vt := VT_EMPTY;
       fcrc.vt := VT_EMPTY;
       szmethod.vt := VT_EMPTY;
       sztime.vt := VT_EMPTY;
       blockpid.vt := VT_EMPTY;
       inA.GetProperty( i, kpidPath, path );
       inA.GetProperty( i, kpidSize, size );
       inA.GetProperty( i, kpidPackedSize, packedsize );
       inA.GetProperty( i, kpidAttributes, attr );
       inA.GetProperty( i, kpidCRC, fcrc );
       inA.GetProperty( i, kpidMethod, szMethod );
       inA.GetProperty( i, kpidLastWriteTime, sztime );
       inA.GetProperty( i, kpidblock, blockpid );
       try
       if ( ( ( attr.uiVal and ( 1 shl 4 ) ) <> 0 ) or ( size.uhVal.QuadPart = 0 ) ) then szMethod_WS := 'None'  // is a directory or 0byte file
        else  //rg 18.04.06
         szMethod_WS := Widestring( szmethod.bstrVal ); //Check for diectoies or 0 byte files, if not an exception happens
       //ErikGG Begin 07.11.06
       //Add all found files and directories to the Files List
       //Is it a directory then add only paths with the backslash
       if ( ( attr.uiVal and ( 1 shl 4 ) ) <> 0 ) then
        ffiles.AddString( Widestring( AppendSlash( path.bstrVal ) ) )
       else
        ffiles.AddString( Widestring( path.bstrVal ) );
       //ErikGG End 07.11.06
       if assigned( Fonlistfile ) then
          Fonlistfile( self,
            Widestring( path.bstrVal ),  //filename 1
            i,                         //fileindex for extracting
            size.uhVal.QuadPart,       //Filesizeunp  2
            packedsize.uhVal.QuadPart, //FilesizeP 3
            ( attr.uhVal.QuadPart and not ( 1 shl 13 ) ), //attr 4 , removes first set bit
            fcrc.uhVal.QuadPart,       //CRC 5
            szMethod_WS,               //method 6
            FileTimeToDateTime( sztime.filetime,2 )  //filetime 7
            );
       except
       end;
   end; //for i:= 0
   Result := FNumberOfFiles;
finally
   ina.Close;
   ResetCancel;
end;
end;
/////// Added MK 30.03.2006
// ErikGG 07.11.06 Rewrote the add method,
function TSevenZip.Add: Integer;
var
  updateCallback: TMyArchiveUpdateCallback;
  intf: IArchiveUpdateCallback;
  outStream: IOutStream;
  i,a,FileAttr{, FtoAdd, fHnd}: Integer;
  FMaxProgress:int64;
  FileDT:TFiletime;
  FileSize_:int64;
  setProperties: ISetProperties;
  SetP: array[ 0..10 ] of PROPVARIANT;
  SetPNames: array[ 0..2 ] of PWideChar;
  FilesinBuffer, CurrBuffSize, NumOfProps: Cardinal;
//Get compression strength for adding
  function SevenZipCompressionStrengthInt( cs: TCompressStrength ): Cardinal;
  begin
    case cs of
      SAVE: result := 0;
      FAST: result := 3;
      NORMAL: result := 5;
      MAXIMUM: result := 7;
      ULTRA: result := 9;
    else
      result := 5;
    end;
  end;
// Shadow 28.11.2006
//Get directory content and recursive if wanted
//------------------------------------------------------------------------------
  procedure AddFile( _Name: WideString; _Size: Int64; _DateTime: _FILETIME; _Attr: Cardinal );
  begin
    if CurrBuffSize <= FilesinBuffer then begin //Increase the Buffers by 100 entries.
      Inc( CurrBuffSize, 100 );
      Setlength( updateCallback.Files, CurrBuffSize );
      Setlength( updateCallback.Files_size, CurrBuffSize );
      Setlength( updateCallback.Files_Date, CurrBuffSize );
      Setlength( updateCallback.Files_Attr, CurrBuffSize );
    end;
    updateCallback.Files[ FilesinBuffer ] := _Name;
    updateCallback.Files_size[ FilesinBuffer ] := _Size;
    updateCallback.Files_Date[ FilesinBuffer ] := _DateTime;
    updateCallback.Files_Attr[ FilesinBuffer ] := _Attr;
    FMaxProgress := FMaxProgress + _Size;
    Inc( FilesinBuffer );
  end;
  procedure AddRootDir( const Dir: WideString );
  var
    s: WideString;
    l: Integer;
  begin
    s := ClearSlash( Dir );
    if not DirectoryExistsW( s ) then Exit;
    GetFileSizeandDateTime_Int64( s, FileSize_, FileDT, FileAttr );
    l := Length( s );
    while ( l > 0 ) and ( s[ l ] <> '' ) do Dec( l );
    s := Copy( s, l + 1, MaxInt );
    AddFile( s, FileSize_, FileDT, FileAttr );
  end;
  procedure GetDirs( Const MainDir, Ext: WideString );
  var
    srw: _Win32_Find_Dataw;
    SearchHandle: Cardinal;
  begin
    srw.dwFileAttributes := faAnyFile;
    SearchHandle := FindFirstFileW( PWideChar( MainDir + '*.*' ), srw );
    if SearchHandle <> INVALID_HANDLE_VALUE then begin
      repeat
        if ( srw.cFileName[ 0 ] = '.' ) then Continue; //Blocks "." and ".." filenames
        if ( ( srw.dwFileAttributes and faDirectory ) = faDirectory ) then begin//Is a Directory
          Addfile(
            MainDir + srw.cFileName,
            srw.nFileSizeHigh shl 32 + srw.nFileSizeLow,
            srw.ftLastWriteTime,
            srw.dwFileAttributes
          );
          if ( AddRecurseDirs in FAddoptions ) then GetDirs( AppendSlash( MainDir + srw.cFileName ), Ext );
        end else begin //Is a file
          if ( Ext <> '.*' ) and ( ExtractFileExtW( srw.cFileName ) <> Ext ) then Continue;
          Addfile(
            MainDir + srw.cFileName,
            srw.nFileSizeHigh shl 32 + srw.nFileSizeLow,
            srw.ftLastWriteTime,
            srw.dwFileAttributes
          );
        end;
      until not FindNextFileW( SearchHandle, srw ) or FMainCancel;
      Windows.FindClose( SearchHandle );
    end;
  end;
{
     procedure SetPassword( Password: String );
     var
       CryptoSetPassword: ICryptoSetPassword;
       Buffer: PChar;
       SizeInBytes: DWORD;
       i: Integer;
     begin
       if not Assigned( SetPwd ) then Exit;
       if SetPwd.QueryInterface( IID_ICryptoSetPassword, CryptoSetPassword ) = S_OK then begin
         SizeInBytes := Length( Password ) * 2;
         GetMem( Buffer, SizeInBytes );
         try
           for i := 0 to Length( Password ) - 1 do begin
             Buffer[ i * 2 ] := Password[ i + 1 ];
             Buffer[ i * 2 + 1 ] := #0;
           end;
           CryptoSetPassword.CryptoSetPassword( Buffer, SizeInBytes );
          finally
           FreeMem( Buffer );
         end;
        end;
     end;
}
begin //main procedure
  try
    updateCallback := TMyArchiveUpdateCallback.Create( self );
// Set FRootDir to uppercase for comparing
// Set AddRootdir for relative path or wholepath
// Set Frootdir to '' to add whole path
    FRootDir := UppercaseW_( FRootDir );
    updateCallback.RootDir := AppendSlash( FRootDir );
    FMaxProgress := 0;
    FilesinBuffer := 0;
    CurrBuffSize := 0;
    for i := 0 to Ffiles.Count- 1 do begin
//Contains a directory in the sence of C:DIR*.*
      a := Pos( '*', Ffiles.WStrings[ i ] );
      if a > 0 then begin
        AddRootDir( AppendSlash( Copy( Ffiles.WStrings[ i ], 1, a-1 ) ) );
        GetDirs( AppendSlash( Copy( Ffiles.WStrings[ i ], 1, a-1 ) ), Copy( ffiles.WStrings[ i ], a + 1, 8 ) );
      end else if FileExists_( Ffiles.WStrings[ i ] ) then begin
        GetFileSizeandDateTime_Int64( Ffiles.Wstrings[ i ],FileSize_, FileDT, FileAttr );
        AddFile( Ffiles.Wstrings[ i ], FileSize_, FileDT, FileAttr );
      end;
    end;
//Reset the Buffers back to the size equaling the number of files.
    SetLength( updateCallback.Files, FilesinBuffer );
    SetLength( updateCallback.Files_size, FilesinBuffer );
    SetLength( updateCallback.Files_Date, FilesinBuffer );
    SetLength( updateCallback.Files_Attr, FilesinBuffer );
//send MaxProgress to App
    if Assigned( OnPreProgress ) then OnPreProgress( Self, FMaxProgress );
  if ( FSFXCreate ) and ( FileExists_( FSFXModule ) ) then begin
    FSevenZipFileName := ChangeFileExtW( FSevenZipFileName,'.exe' );
    if CopyFileW( PWidechar( SFXModule ), PWideChar( FSevenZipFileName ), True ) then
// Shadow 27.11.2006
     outStream := TMyStreamWriter.Create( FSevenZipFileName, Now, FILE_ATTRIBUTE_ARCHIVE, FVolumeSize, TRUE )
    else begin
       if Assigned( onMessage ) then
        OnMessage( self, 1, 'Could not create SFX', '' );
     end;
   end else
   outStream := TMyStreamWriter.Create( FSevenZipFileName, now, FILE_ATTRIBUTE_ARCHIVE, FVolumeSize, FALSE );
  //_______________
  //Setp.vt := VT_EMPTY;
  //Set archive options
  if outA.QueryInterface( IID_ISetProperties, setProperties ) = S_OK then begin
    NumOfProps := 0;
    //rg 17.04.06
    case FCompressType of
     LZMA: begin
            // 7z Profile
            Setp[ NumOfProps ].vt := VT_UI4;
            SetPNames[ NumOfProps ] := StringToOleStr( 'X' );
            Setp[ NumOfProps ].ulVal := SevenZipCompressionStrengthInt( FCompstrength );
            inc( NumOfProps );
            //Solid
            Setp[ NumOfProps ].vt := VT_BSTR;
            SetPNames[ NumOfProps ] := StringToOleStr( 's' );
            if ( AddSolid in FAddoptions ) then
             Setp[ NumOfProps ].bstrVal := SysAllocString( 'on' )
            else
             Setp[ NumOfProps ].bstrVal := SysAllocString( 'off' );
            inc( NumOfProps );
            {
            directorysize 0..27
            No need to set if you use CompressionStrength Profiles
            ( Save...Ultra )
            }
            if FLZMAStrength > 0 then
             begin
              Setp[ NumOfProps ].vt := VT_UI4;
              SetPNames[ NumOfProps ] := StringToOleStr( 'd' );
              Setp[ NumOfProps ].ulVal := FLZMAStrength;
              inc( NumOfProps )
             end;
          end;
     PPMD: begin
            // PPMD compression
            Setp[ NumOfProps ].vt := VT_BSTR;
            SetPNames[ NumOfProps ] := StringToOleStr( '0' );
            Setp[ NumOfProps ].bstrVal := SysAllocString( 'PPMd' );
            inc( NumOfProps );
            //PPMD Size
            //No need to set if you use defaults
            if FPPMDsize > 0 then
             begin
              Setp[ NumOfProps ].vt := VT_UI4;
              SetPNames[ NumOfProps ] := StringToOleStr( 'o' );
              Setp[ NumOfProps ].ulVal := 10;
              inc( NumOfProps );
             end;
            //PPMD Mem
            //No need to set if you use defaults
            if FPPMDmem > 0 then
             begin
              Setp[ NumOfProps ].vt := VT_UI4;
              SetPNames[ NumOfProps ] := StringToOleStr( 'mem' );
              Setp[ NumOfProps ].ulVal := 30;
              inc( NumOfProps );
             end;
           end;
    end; //end case
    if (FPassword <> '') and ( AddEnCryptFilename in FAddoptions ) then
      begin  
        Setp[ NumOfProps ].vt := VT_BSTR;
        SetPNames[ NumOfProps ] := StringToOleStr( 'he' );
        Setp[ NumOfProps ].bstrVal := SysAllocString( 'on' );
        inc( NumOfProps );
      end;
	
    // set options
    result := setProperties.SetProperties( @SetPNames, @Setp, NumOfProps );
   end; //if QuerryInterface
  //____________________
  if FilesinBuffer > 0 then Begin
    intf := updateCallback;
    Result := outA.UpdateItems( outStream, FilesinBuffer, updateCallback );
  end else begin
    if Assigned( OnMessage ) then OnMessage( Self, 1, 'No files to add.', '' );
    Result := -1;
  end;
 finally
  ResetCancel;
 end;
end;
function TSevenZip.Extract( TestArchive:Boolean=False ): Integer;
var
  updateCallback: TMyArchiveExtractCallback;
  updateOpenCallback: TmyArchiveOpenCallback;
  ms: TMyStreamReader;
  filesDW: array of DWORD;
  Filestoex,w: DWORD;
  i,j,n: Integer;
  FMaxProgress:int64;
  size: PROPVARIANT;
// Lifepower (07-Jan-2007):
//  Commented unused variables
//  fnameprop: PROPVARIANT;
//  fileInArchive, fileToExtract: WideString;
begin
try
// 24.08.06 - Matteo Riso - Status: experimental
// 25.08.06 Modified by rg
//
// If we loaded an .EXE file, we could start reading from offset 132096.
// Also supported by newerdll
//  if FIsSFX then ms.Seek( FSFXOffset,0,@FSFXOffset );
// End - MR modification
// Shadow 28.11.2006
    if UppercaseW_( ExtractFileExtW( FSevenZipFileName ) ) = '.EXE' then begin
      if not SFXCheck( FSevenZipFileName ) then begin
        Result := -1;
        if assigned( onMessage ) then onMessage( self, 7, 'File is not an 7z SFX archive', Fsevenzipfilename );
        Exit;
      end;
    end;
    ms := TMyStreamReader.Create( Self, FSevenZipFileName, TRUE );
    inA.Close;
    updateOpenCallback := TMyArchiveOpenCallback.Create( self );
    i := inA.Open( ms, nil, updateOpenCallback );
    if i <> 0 then begin
      Result := -1;
      if assigned( onMessage ) then onMessage( self,1,'File not found',FSevenZipFileName );
      ms.Free;
      Exit;
    end;
    FMaxProgress := 0;
    inA.GetNumberOfItems( w ); //1..end
    dec( w ); //Starting with 0..end-1
    n := 0;
    if FFiles.Count > 0 then begin
      SetLength( filesDW, ffiles.Count );
      for i := 0 to FFiles.count - 1 do begin
        if not TryStrToInt_( Ffiles.WStrings[ i ], j ) then
          j := GetINdexbyFilename( Ffiles.WStrings[ i ] );
          // Lifepower (07-Jan-2007):
          //  Added typecast to prevent warning.
          if (j < 0) or (Int64(j) > w) then begin
            if Assigned( onMessage ) then onMessage( Self, 5, 'Index out of Range', '' );
            Result := -1;
            Exit;
          end;
          size.vt := VT_EMPTY;
          inA.GetProperty( j, kpidSize, size );
          FMaxProgress := FMaxprogress + size.uhVal.QuadPart;
          filesDW[ n ] := j;
          Inc( n );
        end; // For i := 0
      Filestoex := n;
    end else begin
//   extract all files, FFiles.Count must be 0
     FilestoEx := $FFFFFFFF;
    end;
    SetLength( filesDW, n );
//set FMaxProgress for selected files
  if FMaxProgress > 0 then if assigned( OnPreProgress ) then OnPreProgress( self,FMaxProgress );
// filesdw must be sorted asc
  if length( filesdw ) > 1 then SortDWord( filesDW,low( filesdw ),High( filesdw ) );
  updatecallback := TMyArchiveExtractCallback.Create( self );
  updatecallback.FExtractDirectory := appendslash( Fextrbasedir );
  updatecallback.FFilestoextract   := ffiles.Count; //with all files ffiles.count = 0, thats ok
  updatecallback.FAllFilesExt      := false;        //Stop extracting if no more files to extract
  updatecallback.FLastFileToExt    := false;        //only 1 more to extact
  result := inA.Extract( @filesDW[ 0 ], Filestoex, Integer( TestArchive ), updatecallback )
//  mmoLog.Lines.Add( Format( 'IInArchive.Extract: %d', [ result ] ) );
finally
  ina.close;
  ResetCancel;
end;
end;
(*
function TSevenZip.Delete: Integer;
begin
//
end;
*)
//------------------------------------------------------------------------------------------------
//------------------------------------------------------------------------------------------------
//-----------------End SevenZip VCL---------------------------------------------------------
//------------------------------------------------------------------------------------------------
//------------------------------------------------------------------------------------------------
procedure Register;
begin
  RegisterComponents( 'Seven Zip', [ TSevenZip ] );
end;
end.

						