sevenzipvcl.pas

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

   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;
  PInt64        = ^Int64;

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: cardinal; //Integer;                              //FHO  20.01.2007
    Size: Int64;//DWORD;                                      // RG  26.01.2007
    OnRemovableDrive: Boolean;
  end;

  TArrayOfFiles = array of TFiles;                             //FHO 17.01.2007

  TMyStreamWriter = class( TInterfacedObject, ISequentialOutStream, IOutStream )
  private
    arcName: WideString;
    arcDate: Tdatetime;
    arcAttr: DWORD;
    arcCreateSFX: Boolean;
    arcVolumeSize: DWORD;
    arcPosition, arcSize: int64; // DWORD;                     // RG  26.01.2007
    FPLastError:PInteger;                                      //FHO 22.01.2007
    MyLastError: Integer;                                      //FHO 22.01.2007
    Files: TArrayOfFiles;

    function CreateNewFile: Boolean;
  protected
    property TheFiles: TArrayOfFiles read Files;
  public
    destructor Destroy; override;
    constructor Create( PLastError:PInteger;sz: Widestring;    //FHO 22.01.2007
                        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: Int64; //DWORD;                     // RG  26.01.2007
    Files: TArrayOfFiles;
    FOnOpenVolume: TOpenVolume;
    FArchive: Boolean;
    MyLastError: Integer;                                      //FHO 22.01.2007
    
    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;