原始版本: Henri Gourvest <hgourvest@gmail.com> 1.2版本

BUG修改:

1.对于文件名中带有空格的文件, 无法压缩, 原因是1488行, 压缩调用的是TStringList.Delimiter 来拆分文件字符串, 而空格是默认分行符, 导致文件名错误

2.解压缩函数, 如果目标文件已存在并且为只读属性时, 报错, 原因是1105行 创建文件流的时候直接使用了TFileStream.Create(path, fmCreate)导致

3.解压缩函数, 解决如果是空文件夹不会被创建的问题

功能增加:

1.增加了一个WorkPath变量, 用于指定7z.dll文件的绝对路径

2.增加了一个解压缩过程中文件释放失败时的回调T7zProgressExceptCallback, 支持忽略/重试/取消

  1. (********************************************************************************)
  2. (*                        7-ZIP DELPHI API                                      *)
  3. (*                                                                              *)
  4. (* The contents of this file are subject to the Mozilla Public License Version  *)
  5. (* 1.1 (the "License"); you may not use this file except in compliance with the *)
  6. (* License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ *)
  7. (*                                                                              *)
  8. (* Software distributed under the License is distributed on an "AS IS" basis,   *)
  9. (* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *)
  10. (* the specific language governing rights and limitations under the License.    *)
  11. (*                                                                              *)
  12. (* Unit owner : Henri Gourvest <hgourvest@gmail.com>                            *)
  13. (* V1.2.1                                                                       *)
  14. (********************************************************************************)
  15.  
  16. (*
  17. 2017-06-08 刘志林 修改
  18.  
  19. BUG修改:
  20. 1.对于文件名中带有空格的文件, 无法压缩, 原因是1488行, 压缩调用的是TStringList.Delimiter 来拆分文件字符串, 而空格是默认分行符, 导致文件名错误
  21. 2.解压缩函数, 如果目标文件已存在并且为只读属性时, 报错, 原因是1105行 创建文件流的时候直接使用了TFileStream.Create(path, fmCreate)导致
  22. 3.解压缩函数, 解决如果是空文件夹不会被创建的问题
  23.  
  24. 功能增加:
  25. 1.增加了一个WorkPath变量, 用于指定7z.dll文件的绝对路径
  26. 2.增加了一个解压缩过程中文件释放失败时的回调T7zProgressExceptCallback, 支持忽略/重试/取消
  27.  
  28. *)
  29.  
  30. unit SevenZIP;
  31. {$ALIGN ON}
  32. {$MINENUMSIZE 4}
  33. {$WARN SYMBOL_PLATFORM OFF}    
  34.  
  35. interface
  36. uses SysUtils, Windows, ActiveX, Classes, Contnrs;
  37.  
  38. type
  39.   PVarType = ^TVarType;
  40.   PCardArray = ^TCardArray;
  41.   TCardArray = array[..MaxInt div SizeOf(Cardinal) - ] of Cardinal;
  42.  
  43. {$IFNDEF UNICODE}
  44.   UnicodeString = WideString;
  45. {$ENDIF}
  46.  
  47. //******************************************************************************
  48. // PropID.h
  49. //******************************************************************************
  50.  
  51. const
  52.   kpidNoProperty       = ;
  53.  
  54.   kpidHandlerItemIndex = ;
  55.   kpidPath             = ;  // VT_BSTR
  56.   kpidName             = ;  // VT_BSTR
  57.   kpidExtension        = ;  // VT_BSTR
  58.   kpidIsFolder         = ;  // VT_BOOL
  59.   kpidSize             = ;  // VT_UI8
  60.   kpidPackedSize       = ;  // VT_UI8
  61.   kpidAttributes       = ;  // VT_UI4
  62.   kpidCreationTime     = ; // VT_FILETIME
  63.   kpidLastAccessTime   = ; // VT_FILETIME
  64.   kpidLastWriteTime    = ; // VT_FILETIME
  65.   kpidSolid            = ; // VT_BOOL
  66.   kpidCommented        = ; // VT_BOOL
  67.   kpidEncrypted        = ; // VT_BOOL
  68.   kpidSplitBefore      = ; // VT_BOOL
  69.   kpidSplitAfter       = ; // VT_BOOL
  70.   kpidDictionarySize   = ; // VT_UI4
  71.   kpidCRC              = ; // VT_UI4
  72.   kpidType             = ; // VT_BSTR
  73.   kpidIsAnti           = ; // VT_BOOL
  74.   kpidMethod           = ; // VT_BSTR
  75.   kpidHostOS           = ; // VT_BSTR
  76.   kpidFileSystem       = ; // VT_BSTR
  77.   kpidUser             = ; // VT_BSTR
  78.   kpidGroup            = ; // VT_BSTR
  79.   kpidBlock            = ; // VT_UI4
  80.   kpidComment          = ; // VT_BSTR
  81.   kpidPosition         = ; // VT_UI4
  82.   kpidPrefix           = ; // VT_BSTR
  83.   kpidNumSubDirs       = ; // VT_UI4
  84.   kpidNumSubFiles      = ; // VT_UI4
  85.   kpidUnpackVer        = ; // VT_UI1
  86.   kpidVolume           = ; // VT_UI4
  87.   kpidIsVolume         = ; // VT_BOOL
  88.   kpidOffset           = ; // VT_UI8
  89.   kpidLinks            = ; // VT_UI4
  90.   kpidNumBlocks        = ; // VT_UI4
  91.   kpidNumVolumes       = ; // VT_UI4
  92.   kpidTimeType         = ; // VT_UI4
  93.   kpidBit64            = ; // VT_BOOL
  94.   kpidBigEndian        = ; // VT_BOOL
  95.   kpidCpu              = ; // VT_BSTR
  96.   kpidPhySize          = ; // VT_UI8
  97.   kpidHeadersSize      = ; // VT_UI8
  98.   kpidChecksum         = ; // VT_UI4
  99.   kpidCharacts         = ; // VT_BSTR
  100.   kpidVa               = ; // VT_UI8
  101.  
  102.   kpidTotalSize        = $; // VT_UI8
  103.   kpidFreeSpace        = kpidTotalSize + ; // VT_UI8
  104.   kpidClusterSize      = kpidFreeSpace + ; // VT_UI8
  105.   kpidVolumeName       = kpidClusterSize + ; // VT_BSTR
  106.  
  107.   kpidLocalName        = $; // VT_BSTR
  108.   kpidProvider         = kpidLocalName + ; // VT_BSTR
  109.  
  110.   kpidUserDefined      = $;
  111.  
  112. //******************************************************************************
  113. // IProgress.h
  114. //******************************************************************************
  115. type
  116.   IProgress = interface(IUnknown)
  117.   ['{23170F69-40C1-278A-0000-000000050000}']
  118.     function SetTotal(total: Int64): HRESULT; stdcall;
  119.     function SetCompleted(completeValue: PInt64): HRESULT; stdcall;
  120.   end;
  121.  
  122. //******************************************************************************
  123. // IPassword.h
  124. //******************************************************************************
  125.  
  126.   ICryptoGetTextPassword = interface(IUnknown)
  127.   ['{23170F69-40C1-278A-0000-000500100000}']
  128.     function CryptoGetTextPassword(var password: TBStr): HRESULT; stdcall;
  129.   end;
  130.  
  131.   ICryptoGetTextPassword2 = interface(IUnknown)
  132.   ['{23170F69-40C1-278A-0000-000500110000}']
  133.     function CryptoGetTextPassword2(passwordIsDefined: PInteger; var password: TBStr): HRESULT; stdcall;
  134.   end;
  135.  
  136. //******************************************************************************
  137. // IStream.h
  138. // "23170F69-40C1-278A-0000-000300xx0000"
  139. //******************************************************************************
  140.  
  141.   ISequentialInStream = interface(IUnknown)
  142.   ['{23170F69-40C1-278A-0000-000300010000}']
  143.     function Read(data: Pointer; size: Cardinal; processedSize: PCardinal): HRESULT; stdcall;
  144.     (*
  145.     Out: if size != 0, return_value = S_OK and (*processedSize == 0),
  146.       then there are no more bytes in stream.
  147.     if (size > 0) && there are bytes in stream,
  148.     this function must read at least 1 byte.
  149.     This function is allowed to read less than number of remaining bytes in stream.
  150.     You must call Read function in loop, if you need exact amount of data
  151.     *)
  152.   end;
  153.  
  154.   ISequentialOutStream = interface(IUnknown)
  155.   ['{23170F69-40C1-278A-0000-000300020000}']
  156.     function Write(data: Pointer; size: Cardinal; processedSize: PCardinal): HRESULT; stdcall;
  157.     (*
  158.     if (size > 0) this function must write at least 1 byte.
  159.     This function is allowed to write less than "size".
  160.     You must call Write function in loop, if you need to write exact amount of data
  161.     *)
  162.   end;
  163.  
  164.   IInStream = interface(ISequentialInStream)
  165.   ['{23170F69-40C1-278A-0000-000300030000}']
  166.     function Seek(offset: Int64; seekOrigin: Cardinal; newPosition: PInt64): HRESULT; stdcall;
  167.   end;
  168.  
  169.   IOutStream = interface(ISequentialOutStream)
  170.   ['{23170F69-40C1-278A-0000-000300040000}']
  171.     function Seek(offset: Int64; seekOrigin: Cardinal; newPosition: PInt64): HRESULT; stdcall;
  172.     function SetSize(newSize: Int64): HRESULT; stdcall;
  173.   end;
  174.  
  175.   IStreamGetSize = interface(IUnknown)
  176.   ['{23170F69-40C1-278A-0000-000300060000}']
  177.     function GetSize(size: PInt64): HRESULT; stdcall;
  178.   end;
  179.  
  180.   IOutStreamFlush = interface(IUnknown)
  181.   ['{23170F69-40C1-278A-0000-000300070000}']
  182.     function Flush: HRESULT; stdcall;
  183.   end;
  184.  
  185. //******************************************************************************
  186. // IArchive.h
  187. //******************************************************************************
  188.  
  189. // MIDL_INTERFACE("23170F69-40C1-278A-0000-000600xx0000")
  190. //#define ARCHIVE_INTERFACE_SUB(i, base,  x) \
  191. //DEFINE_GUID(IID_ ## i, \
  192. //0x23170F69, 0x40C1, 0x278A, 0x00, 0x00, 0x00, 0x06, 0x00, x, 0x00, 0x00); \
  193. //struct i: public base
  194.  
  195. //#define ARCHIVE_INTERFACE(i, x) ARCHIVE_INTERFACE_SUB(i, IUnknown, x)
  196.  
  197. type
  198. // NFileTimeType
  199.   NFileTimeType = (
  200.     kWindows = ,
  201.     kUnix,
  202.     kDOS
  203.   );
  204.  
  205. // NArchive::
  206.   NArchive = (
  207.     kName = ,          // string
  208.     kClassID,           // GUID
  209.     kExtension,         // string  zip rar gz
  210.     kAddExtension,      // sub archive: tar
  211.     kUpdate,            // bool
  212.     kKeepName,          // bool
  213.     kStartSignature,    // string[4] ex: PK.. 7z.. Rar!
  214.     kFinishSignature,
  215.     kAssociate
  216.   );
  217.  
  218. // NArchive::NExtract::NAskMode
  219.   NAskMode = (
  220.     kExtract = ,
  221.     kTest,
  222.     kSkip
  223.   );
  224.  
  225. // NArchive::NExtract::NOperationResult
  226.   NExtOperationResult = (
  227.     kOK = ,
  228.     kUnSupportedMethod,
  229.     kDataError,
  230.     kCRCError
  231.   );
  232.  
  233. // NArchive::NUpdate::NOperationResult
  234.   NUpdOperationResult = (
  235.     kOK_   = ,
  236.     kError
  237.   );
  238.  
  239.   IArchiveOpenCallback = interface
  240.   ['{23170F69-40C1-278A-0000-000600100000}']
  241.     function SetTotal(files, bytes: PInt64): HRESULT; stdcall;
  242.     function SetCompleted(files, bytes: PInt64): HRESULT; stdcall;
  243.   end;
  244.  
  245.   IArchiveExtractCallback = interface(IProgress)
  246.   ['{23170F69-40C1-278A-0000-000600200000}']
  247.     function GetStream(index: Cardinal; var outStream: ISequentialOutStream;
  248.         askExtractMode: NAskMode): HRESULT; stdcall;
  249.     // GetStream OUT: S_OK - OK, S_FALSE - skeep this file
  250.     function PrepareOperation(askExtractMode: NAskMode): HRESULT; stdcall;
  251.     function SetOperationResult(resultEOperationResult: NExtOperationResult): HRESULT; stdcall;
  252.   end;
  253.  
  254.   IArchiveOpenVolumeCallback = interface
  255.   ['{23170F69-40C1-278A-0000-000600300000}']
  256.     function GetProperty(propID: PROPID; var value: OleVariant): HRESULT; stdcall;
  257.     function GetStream(const name: PWideChar; var inStream: IInStream): HRESULT; stdcall;
  258.   end;
  259.  
  260.   IInArchiveGetStream = interface
  261.   ['{23170F69-40C1-278A-0000-000600400000}']
  262.     function GetStream(index: Cardinal; var stream: ISequentialInStream ): HRESULT; stdcall;
  263.   end;
  264.  
  265.   IArchiveOpenSetSubArchiveName = interface
  266.   ['{23170F69-40C1-278A-0000-000600500000}']
  267.     function SetSubArchiveName(name: PWideChar): HRESULT; stdcall;
  268.   end;
  269.  
  270.   IInArchive = interface
  271.   ['{23170F69-40C1-278A-0000-000600600000}']
  272.     function Open(stream: IInStream; const maxCheckStartPosition: PInt64;
  273.         openArchiveCallback: IArchiveOpenCallback): HRESULT; stdcall;
  274.     function Close: HRESULT; stdcall;
  275.     function GetNumberOfItems(var numItems: CArdinal): HRESULT; stdcall;
  276.     function GetProperty(index: Cardinal; propID: PROPID; var value: OleVariant): HRESULT; stdcall;
  277.     function Extract(indices: PCardArray; numItems: Cardinal;
  278.         testMode: Integer; extractCallback: IArchiveExtractCallback): HRESULT; stdcall;
  279.     // indices must be sorted
  280.     // numItems = 0xFFFFFFFF means all files
  281.     // testMode != 0 means "test files operation"
  282.  
  283.     function GetArchiveProperty(propID: PROPID; var value: OleVariant): HRESULT; stdcall;
  284.  
  285.     function GetNumberOfProperties(numProperties: PCardinal): HRESULT; stdcall;
  286.     function GetPropertyInfo(index: Cardinal;
  287.         name: PBSTR; propID: PPropID; varType: PVarType): HRESULT; stdcall;
  288.  
  289.     function GetNumberOfArchiveProperties(var numProperties: Cardinal): HRESULT; stdcall;
  290.     function GetArchivePropertyInfo(index: Cardinal;
  291.         name: PBSTR; propID: PPropID; varType: PVARTYPE): HRESULT; stdcall;
  292.   end;
  293.  
  294.   IArchiveUpdateCallback = interface(IProgress)
  295.   ['{23170F69-40C1-278A-0000-000600800000}']
  296.     function GetUpdateItemInfo(index: Cardinal;
  297.         newData: PInteger; // 1 - new data, 0 - old data
  298.         newProperties: PInteger; // 1 - new properties, 0 - old properties
  299.         indexInArchive: PCardinal // -1 if there is no in archive, or if doesn't matter
  300.         ): HRESULT; stdcall;
  301.     function GetProperty(index: Cardinal; propID: PROPID; var value: OleVariant): HRESULT; stdcall;
  302.     function GetStream(index: Cardinal; var inStream: ISequentialInStream): HRESULT; stdcall;
  303.     function SetOperationResult(operationResult: Integer): HRESULT; stdcall;
  304.   end;
  305.  
  306.   IArchiveUpdateCallback2 = interface(IArchiveUpdateCallback)
  307.   ['{23170F69-40C1-278A-0000-000600820000}']
  308.     function GetVolumeSize(index: Cardinal; size: PInt64): HRESULT; stdcall;
  309.     function GetVolumeStream(index: Cardinal; var volumeStream: ISequentialOutStream): HRESULT; stdcall;
  310.   end;
  311.  
  312.   IOutArchive = interface
  313.   ['{23170F69-40C1-278A-0000-000600A00000}']
  314.     function UpdateItems(outStream: ISequentialOutStream; numItems: Cardinal;
  315.       updateCallback: IArchiveUpdateCallback): HRESULT; stdcall;
  316.     function GetFileTimeType(type_: PCardinal): HRESULT; stdcall;
  317.   end;
  318.  
  319.   ISetProperties = interface
  320.   ['{23170F69-40C1-278A-0000-000600030000}']
  321.     function SetProperties(names: PPWideChar; values: PPROPVARIANT; numProperties: Integer): HRESULT; stdcall;
  322.   end;
  323.  
  324. //******************************************************************************
  325. // ICoder.h
  326. // "23170F69-40C1-278A-0000-000400xx0000"
  327. //******************************************************************************
  328.  
  329.   ICompressProgressInfo = interface
  330.   ['{23170F69-40C1-278A-0000-000400040000}']
  331.     function SetRatioInfo(inSize, outSize: PInt64): HRESULT; stdcall;
  332.   end;
  333.  
  334.   ICompressCoder = interface
  335.   ['{23170F69-40C1-278A-0000-000400050000}']
  336.   function Code(inStream, outStream: ISequentialInStream;
  337.       inSize, outSize: PInt64;
  338.       progress: ICompressProgressInfo): HRESULT; stdcall;
  339.   end;
  340.  
  341.   ICompressCoder2 = interface
  342.   ['{23170F69-40C1-278A-0000-000400180000}']
  343.   function Code(var inStreams: ISequentialInStream;
  344.       var inSizes: PInt64;
  345.       numInStreams: Cardinal;
  346.       var outStreams: ISequentialOutStream;
  347.       var outSizes: PInt64;
  348.       numOutStreams: Cardinal;
  349.       progress: ICompressProgressInfo): HRESULT; stdcall;
  350.   end;
  351.  
  352. const
  353. //NCoderPropID::
  354.   kDictionarySize    = $;
  355.   kUsedMemorySize    = kDictionarySize + ;
  356.   kOrder             = kUsedMemorySize + ;
  357.   kPosStateBits      = $;
  358.   kLitContextBits    = kPosStateBits + ;
  359.   kLitPosBits        = kLitContextBits + ;
  360.   kNumFastBytes      = $;
  361.   kMatchFinder       = kNumFastBytes + ;
  362.   kMatchFinderCycles = kMatchFinder + ;
  363.   kNumPasses         = $;
  364.   kAlgorithm         = $;
  365.   kMultiThread       = $;
  366.   kNumThreads        = kMultiThread + ;
  367.   kEndMarker         = $;
  368.  
  369. type
  370.   ICompressSetCoderProperties = interface
  371.   ['{23170F69-40C1-278A-0000-000400200000}']
  372.     function SetCoderProperties(propIDs: PPropID;
  373.       properties: PROPVARIANT; numProperties: Cardinal): HRESULT; stdcall;
  374.   end;
  375.  
  376. (*
  377. CODER_INTERFACE(ICompressSetCoderProperties, 0x21)
  378. {
  379.   STDMETHOD(SetDecoderProperties)(ISequentialInStream *inStream) PURE;
  380. };
  381. *)
  382.  
  383.   ICompressSetDecoderProperties2 = interface
  384.   ['{23170F69-40C1-278A-0000-000400220000}']
  385.     function SetDecoderProperties2(data: PByte; size: Cardinal): HRESULT; stdcall;
  386.   end;
  387.  
  388.   ICompressWriteCoderProperties = interface
  389.   ['{23170F69-40C1-278A-0000-000400230000}']
  390.     function WriteCoderProperties(outStreams: ISequentialOutStream): HRESULT; stdcall;
  391.   end;
  392.  
  393.   ICompressGetInStreamProcessedSize = interface
  394.   ['{23170F69-40C1-278A-0000-000400240000}']
  395.     function GetInStreamProcessedSize(value: PInt64): HRESULT; stdcall;
  396.   end;
  397.  
  398.   ICompressSetCoderMt = interface
  399.   ['{23170F69-40C1-278A-0000-000400250000}']
  400.     function SetNumberOfThreads(numThreads: Cardinal): HRESULT; stdcall;
  401.   end;
  402.  
  403.   ICompressGetSubStreamSize = interface
  404.   ['{23170F69-40C1-278A-0000-000400300000}']
  405.     function GetSubStreamSize(subStream: Int64; value: PInt64): HRESULT; stdcall;
  406.   end;
  407.  
  408.   ICompressSetInStream = interface
  409.   ['{23170F69-40C1-278A-0000-000400310000}']
  410.     function SetInStream(inStream: ISequentialInStream): HRESULT; stdcall;
  411.     function ReleaseInStream: HRESULT; stdcall;
  412.   end;
  413.  
  414.   ICompressSetOutStream = interface
  415.   ['{23170F69-40C1-278A-0000-000400320000}']
  416.     function SetOutStream(outStream: ISequentialOutStream): HRESULT; stdcall;
  417.     function ReleaseOutStream: HRESULT; stdcall;
  418.   end;
  419.  
  420.   ICompressSetInStreamSize = interface
  421.   ['{23170F69-40C1-278A-0000-000400330000}']
  422.     function SetInStreamSize(inSize: PInt64): HRESULT; stdcall;
  423.   end;
  424.  
  425.   ICompressSetOutStreamSize = interface
  426.   ['{23170F69-40C1-278A-0000-000400340000}']
  427.     function SetOutStreamSize(outSize: PInt64): HRESULT; stdcall;
  428.   end;
  429.  
  430.   ICompressFilter = interface
  431.   ['{23170F69-40C1-278A-0000-000400400000}']
  432.     function Init: HRESULT; stdcall;
  433.     function Filter(data: PByte; size: Cardinal): Cardinal; stdcall;
  434.     // Filter return outSize (Cardinal)
  435.     // if (outSize <= size): Filter have converted outSize bytes
  436.     // if (outSize > size): Filter have not converted anything.
  437.     //      and it needs at least outSize bytes to convert one block
  438.     //      (it's for crypto block algorithms).
  439.   end;
  440.  
  441.   ICryptoProperties = interface
  442.   ['{23170F69-40C1-278A-0000-000400800000}']
  443.     function SetKey(Data: PByte; size: Cardinal): HRESULT; stdcall;
  444.     function SetInitVector(data: PByte; size: Cardinal): HRESULT; stdcall;
  445.   end;
  446.  
  447.   ICryptoSetPassword = interface
  448.   ['{23170F69-40C1-278A-0000-000400900000}']
  449.     function CryptoSetPassword(data: PByte; size: Cardinal): HRESULT; stdcall;
  450.   end;
  451.  
  452.   ICryptoSetCRC = interface
  453.   ['{23170F69-40C1-278A-0000-000400A00000}']
  454.     function CryptoSetCRC(crc: Cardinal): HRESULT; stdcall;
  455.   end;
  456.  
  457. //////////////////////
  458. // It's for DLL file
  459. //NMethodPropID::
  460.   NMethodPropID = (
  461.     kID = ,
  462.     kName_,
  463.     kDecoder,
  464.     kEncoder,
  465.     kInStreams,
  466.     kOutStreams,
  467.     kDescription,
  468.     kDecoderIsAssigned,
  469.     kEncoderIsAssigned
  470.   );
  471.  
  472. //******************************************************************************
  473. // CLASSES
  474. //******************************************************************************
  475.  
  476.   T7zPasswordCallback = function(sender: Pointer; var password: UnicodeString): HRESULT; stdcall;
  477.   T7zGetStreamCallBack = function(sender: Pointer; index: Cardinal;
  478.     var outStream: ISequentialOutStream): HRESULT; stdcall;
  479.   T7zProgressCallback = function(sender: Pointer; total: boolean; value: int64): HRESULT; stdcall;
  480.  
  481.   NECallBack = (
  482.     EC_RETRY = ,
  483.     EC_IGNORE,
  484.     EC_CANCEL
  485.   );
  486.  
  487.   T7zProgressExceptCallback = function(sender: Pointer; AFile: UnicodeString): NECallBack; stdcall;
  488.  
  489.   I7zInArchive = interface
  490.   ['{022CF785-3ECE-46EF-9755-291FA84CC6C9}']
  491.     procedure OpenFile(const filename: string); stdcall;
  492.     procedure OpenStream(stream: IInStream); stdcall;
  493.     procedure Close; stdcall;
  494.     function GetNumberOfItems: Cardinal; stdcall;
  495.     function GetItemPath(const index: integer): UnicodeString; stdcall;
  496.     function GetItemName(const index: integer): UnicodeString; stdcall;
  497.     function GetItemSize(const index: integer): Cardinal; stdcall;
  498.     function GetItemIsFolder(const index: integer): boolean; stdcall;
  499.     function GetInArchive: IInArchive;
  500.     procedure ExtractItem(const item: Cardinal; Stream: TStream; test: longbool); stdcall;
  501.     procedure ExtractItems(items: PCardArray; count: cardinal; test: longbool;
  502.       sender: pointer; callback: T7zGetStreamCallBack); stdcall;
  503.     procedure ExtractAll(test: longbool; sender: pointer; callback: T7zGetStreamCallBack); stdcall;
  504.     procedure ExtractTo(const path: string); stdcall;
  505.     procedure SetPasswordCallback(sender: Pointer; callback: T7zPasswordCallback); stdcall;
  506.     procedure SetPassword(const password: UnicodeString); stdcall;
  507.     procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall;
  508.     procedure SetProgressExceptCallback(sender: Pointer; callback: T7zProgressExceptCallback); stdcall;
  509.     procedure SetClassId(const classid: TGUID);
  510.     function GetClassId: TGUID;
  511.     property ClassId: TGUID read GetClassId write SetClassId;
  512.     property NumberOfItems: Cardinal read GetNumberOfItems;
  513.     property ItemPath[const index: integer]: UnicodeString read GetItemPath;
  514.     property ItemName[const index: integer]: UnicodeString read GetItemName;
  515.     property ItemSize[const index: integer]: Cardinal read GetItemSize;
  516.     property ItemIsFolder[const index: integer]: boolean read GetItemIsFolder;
  517.     property InArchive: IInArchive read GetInArchive;
  518.   end;
  519.  
  520.   I7zOutArchive = interface
  521.   ['{BAA9D5DC-9FF4-4382-9BFD-EC9065BD0125}']
  522.     procedure AddStream(Stream: TStream; Ownership: TStreamOwnership; Attributes: Cardinal;
  523.       CreationTime, LastWriteTime: TFileTime; const Path: UnicodeString;
  524.       IsFolder, IsAnti: boolean); stdcall;
  525.     procedure AddFile(const Filename: TFileName; const Path: UnicodeString); stdcall;
  526.     procedure AddFiles(const Dir, Path, Willcards: string; recurse: boolean); stdcall;
  527.     procedure SaveToFile(const FileName: TFileName); stdcall;
  528.     procedure SaveToStream(stream: TStream); stdcall;
  529.     procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall;
  530.     procedure CrearBatch; stdcall;
  531.     procedure SetPassword(const password: UnicodeString); stdcall;
  532.     procedure SetPropertie(name: UnicodeString; value: OleVariant); stdcall;
  533.     procedure SetClassId(const classid: TGUID);
  534.     function GetClassId: TGUID;
  535.     property ClassId: TGUID read GetClassId write SetClassId;
  536.   end;
  537.  
  538.   I7zCodec = interface
  539.   ['{AB48F772-F6B1-411E-907F-1567DB0E93B3}']
  540.  
  541.   end;
  542.  
  543.   T7zStream = class(TInterfacedObject, IInStream, IStreamGetSize,
  544.     ISequentialOutStream, ISequentialInStream, IOutStream, IOutStreamFlush)
  545.   private
  546.     FStream: TStream;
  547.     FOwnership: TStreamOwnership;
  548.   protected
  549.     function Read(data: Pointer; size: Cardinal; processedSize: PCardinal): HRESULT; stdcall;
  550.     function Seek(offset: Int64; seekOrigin: Cardinal; newPosition: Pint64): HRESULT; stdcall;
  551.     function GetSize(size: PInt64): HRESULT; stdcall;
  552.     function SetSize(newSize: Int64): HRESULT; stdcall;
  553.     function Write(data: Pointer; size: Cardinal; processedSize: PCardinal): HRESULT; stdcall;
  554.     function Flush: HRESULT; stdcall;
  555.   public
  556.     constructor Create(Stream: TStream; Ownership: TStreamOwnership = soReference);
  557.     destructor Destroy; override;
  558.   end;
  559.  
  560.   // I7zOutArchive property setters
  561. type
  562.   TZipCompressionMethod = (mzCopy, mzDeflate, mzDeflate64, mzBZip2);
  563.   T7zCompressionMethod = (m7Copy, m7LZMA, m7BZip2, m7PPMd, m7Deflate, m7Deflate64);
  564.                                                                                               //  ZIP 7z GZIP BZ2
  565.   procedure SetCompressionLevel(Arch: I7zOutArchive; level: Cardinal);                        //   X   X   X   X
  566.   procedure SetMultiThreading(Arch: I7zOutArchive; ThreadCount: Cardinal);                    //   X   X       X
  567.  
  568.   procedure SetCompressionMethod(Arch: I7zOutArchive; method: TZipCompressionMethod);         //   X
  569.   procedure SetDictionnarySize(Arch: I7zOutArchive; size: Cardinal); // < 32                  //   X           X
  570.   procedure SetDeflateNumPasses(Arch: I7zOutArchive; pass: Cardinal);                         //   X       X   X
  571.   procedure SetNumFastBytes(Arch: I7zOutArchive; fb: Cardinal);                               //   X       X
  572.   procedure SetNumMatchFinderCycles(Arch: I7zOutArchive; mc: Cardinal);                       //   X       X
  573.  
  574.   procedure SevenZipSetCompressionMethod(Arch: I7zOutArchive; method: T7zCompressionMethod);  //       X
  575.   procedure SevenZipSetBindInfo(Arch: I7zOutArchive; const bind: UnicodeString);                 //       X
  576.   procedure SevenZipSetSolidSettings(Arch: I7zOutArchive; solid: boolean);                    //       X
  577.   procedure SevenZipRemoveSfxBlock(Arch: I7zOutArchive; remove: boolean);                     //       X
  578.   procedure SevenZipAutoFilter(Arch: I7zOutArchive; auto: boolean);                           //       X
  579.   procedure SevenZipCompressHeaders(Arch: I7zOutArchive; compress: boolean);                  //       X
  580.   procedure SevenZipCompressHeadersFull(Arch: I7zOutArchive; compress: boolean);              //       X
  581.   procedure SevenZipEncryptHeaders(Arch: I7zOutArchive; Encrypt: boolean);                    //       X
  582.   procedure SevenZipVolumeMode(Arch: I7zOutArchive; Mode: boolean);                           //       X
  583.  
  584.   // filetime util functions
  585.   function DateTimeToFileTime(dt: TDateTime): TFileTime;
  586.   function FileTimeToDateTime(ft: TFileTime): TDateTime;
  587.   function CurrentFileTime: TFileTime;
  588.  
  589.   // constructors
  590.  
  591.   function CreateInArchive(const classid: TGUID): I7zInArchive;
  592.   function CreateOutArchive(const classid: TGUID): I7zOutArchive;
  593.  
  594. const
  595.   CLSID_CFormatZip      : TGUID = '{23170F69-40C1-278A-1000-000110010000}'; // zip jar xpi
  596.   CLSID_CFormatBZ2      : TGUID = '{23170F69-40C1-278A-1000-000110020000}'; // bz2 bzip2 tbz2 tbz
  597.   CLSID_CFormatRar      : TGUID = '{23170F69-40C1-278A-1000-000110030000}'; // rar r00
  598.   CLSID_CFormatArj      : TGUID = '{23170F69-40C1-278A-1000-000110040000}'; // arj
  599.   CLSID_CFormatZ        : TGUID = '{23170F69-40C1-278A-1000-000110050000}'; // z taz
  600.   CLSID_CFormatLzh      : TGUID = '{23170F69-40C1-278A-1000-000110060000}'; // lzh lha
  601.   CLSID_CFormat7z       : TGUID = '{23170F69-40C1-278A-1000-000110070000}'; // 7z
  602.   CLSID_CFormatCab      : TGUID = '{23170F69-40C1-278A-1000-000110080000}'; // cab
  603.   CLSID_CFormatNsis     : TGUID = '{23170F69-40C1-278A-1000-000110090000}';
  604.   CLSID_CFormatLzma     : TGUID = '{23170F69-40C1-278A-1000-0001100A0000}'; // lzma lzma86
  605.   CLSID_CFormatPe       : TGUID = '{23170F69-40C1-278A-1000-000110DD0000}';
  606.   CLSID_CFormatElf      : TGUID = '{23170F69-40C1-278A-1000-000110DE0000}';
  607.   CLSID_CFormatMacho    : TGUID = '{23170F69-40C1-278A-1000-000110DF0000}';
  608.   CLSID_CFormatUdf      : TGUID = '{23170F69-40C1-278A-1000-000110E00000}'; // iso
  609.   CLSID_CFormatXar      : TGUID = '{23170F69-40C1-278A-1000-000110E10000}'; // xar
  610.   CLSID_CFormatMub      : TGUID = '{23170F69-40C1-278A-1000-000110E20000}';
  611.   CLSID_CFormatHfs      : TGUID = '{23170F69-40C1-278A-1000-000110E30000}';
  612.   CLSID_CFormatDmg      : TGUID = '{23170F69-40C1-278A-1000-000110E40000}'; // dmg
  613.   CLSID_CFormatCompound : TGUID = '{23170F69-40C1-278A-1000-000110E50000}'; // msi doc xls ppt
  614.   CLSID_CFormatWim      : TGUID = '{23170F69-40C1-278A-1000-000110E60000}'; // wim swm
  615.   CLSID_CFormatIso      : TGUID = '{23170F69-40C1-278A-1000-000110E70000}'; // iso
  616.   CLSID_CFormatBkf      : TGUID = '{23170F69-40C1-278A-1000-000110E80000}';
  617.   CLSID_CFormatChm      : TGUID = '{23170F69-40C1-278A-1000-000110E90000}'; // chm chi chq chw hxs hxi hxr hxq hxw lit
  618.   CLSID_CFormatSplit    : TGUID = '{23170F69-40C1-278A-1000-000110EA0000}'; //
  619.   CLSID_CFormatRpm      : TGUID = '{23170F69-40C1-278A-1000-000110EB0000}'; // rpm
  620.   CLSID_CFormatDeb      : TGUID = '{23170F69-40C1-278A-1000-000110EC0000}'; // deb
  621.   CLSID_CFormatCpio     : TGUID = '{23170F69-40C1-278A-1000-000110ED0000}'; // cpio
  622.   CLSID_CFormatTar      : TGUID = '{23170F69-40C1-278A-1000-000110EE0000}'; // tar
  623.   CLSID_CFormatGZip     : TGUID = '{23170F69-40C1-278A-1000-000110EF0000}'; // gz gzip tgz tpz
  624.  
  625. var
  626.   WorkPath: string; {工作路径，查找dll用}
  627.  
  628. implementation
  629.  
  630. const
  631.   MAXCHECK : int64 = ( shl );
  632.   ZipCompressionMethod: array[TZipCompressionMethod] of UnicodeString = ('COPY', 'DEFLATE', 'DEFLATE64', 'BZIP2');
  633.   SevCompressionMethod: array[T7zCompressionMethod] of UnicodeString = ('COPY', 'LZMA', 'BZIP2', 'PPMD', 'DEFLATE', 'DEFLATE64');
  634.  
  635. function DateTimeToFileTime(dt: TDateTime): TFileTime;
  636. var
  637.   st: TSystemTime;
  638. begin
  639.   DateTimeToSystemTime(dt, st);
  640.   if not (SystemTimeToFileTime(st, Result) and LocalFileTimeToFileTime(Result, Result))
  641.     then RaiseLastOSError;
  642. end;
  643.  
  644. function FileTimeToDateTime(ft: TFileTime): TDateTime;
  645. var
  646.   st: TSystemTime;
  647. begin
  648.   if not (FileTimeToLocalFileTime(ft, ft) and FileTimeToSystemTime(ft, st)) then
  649.     RaiseLastOSError;
  650.   Result := SystemTimeToDateTime(st);
  651. end;
  652.  
  653. function CurrentFileTime: TFileTime;
  654. begin
  655.   GetSystemTimeAsFileTime(Result);
  656. end;
  657.  
  658. procedure RINOK(const hr: HRESULT);
  659. begin
  660.   if hr <> S_OK then
  661.     raise Exception.Create(SysErrorMessage(hr));
  662. end;
  663.  
  664. procedure SetCardinalProperty(arch: I7zOutArchive; const name: UnicodeString; card: Cardinal);
  665. var
  666.   value: OleVariant;
  667. begin
  668.   TPropVariant(value).vt := VT_UI4;
  669.   TPropVariant(value).ulVal := card;
  670.   arch.SetPropertie(name, value);
  671. end;
  672.  
  673. procedure SetBooleanProperty(arch: I7zOutArchive; const name: UnicodeString; bool: boolean);
  674. begin
  675.   case bool of
  676.     true: arch.SetPropertie(name, 'ON');
  677.     false: arch.SetPropertie(name, 'OFF');
  678.   end;
  679. end;
  680.  
  681. procedure SetCompressionLevel(Arch: I7zOutArchive; level: Cardinal);
  682. begin
  683.   SetCardinalProperty(arch, 'X', level);
  684. end;
  685.  
  686. procedure SetMultiThreading(Arch: I7zOutArchive; ThreadCount: Cardinal);
  687. begin
  688.   SetCardinalProperty(arch, 'MT', ThreadCount);
  689. end;
  690.  
  691. procedure SetCompressionMethod(Arch: I7zOutArchive; method: TZipCompressionMethod);
  692. begin
  693.   Arch.SetPropertie('M', ZipCompressionMethod[method]);
  694. end;
  695.  
  696. procedure SetDictionnarySize(Arch: I7zOutArchive; size: Cardinal);
  697. begin
  698.   SetCardinalProperty(arch, 'D', size);
  699. end;
  700.  
  701. procedure SetDeflateNumPasses(Arch: I7zOutArchive; pass: Cardinal);
  702. begin
  703.   SetCardinalProperty(arch, 'PASS', pass);
  704. end;
  705.  
  706. procedure SetNumFastBytes(Arch: I7zOutArchive; fb: Cardinal);
  707. begin
  708.   SetCardinalProperty(arch, 'FB', fb);
  709. end;
  710.  
  711. procedure SetNumMatchFinderCycles(Arch: I7zOutArchive; mc: Cardinal);
  712. begin
  713.   SetCardinalProperty(arch, 'MC', mc);
  714. end;
  715.  
  716. procedure SevenZipSetCompressionMethod(Arch: I7zOutArchive; method: T7zCompressionMethod);
  717. begin
  718.   Arch.SetPropertie('', SevCompressionMethod[method]);
  719. end;
  720.  
  721. procedure SevenZipSetBindInfo(Arch: I7zOutArchive; const bind: UnicodeString);
  722. begin
  723.   arch.SetPropertie('B', bind);
  724. end;
  725.  
  726. procedure SevenZipSetSolidSettings(Arch: I7zOutArchive; solid: boolean);
  727. begin
  728.   SetBooleanProperty(Arch, 'S', solid);
  729. end;
  730.  
  731. procedure SevenZipRemoveSfxBlock(Arch: I7zOutArchive; remove: boolean);
  732. begin
  733.   SetBooleanProperty(arch, 'RSFX', remove);
  734. end;
  735.  
  736. procedure SevenZipAutoFilter(Arch: I7zOutArchive; auto: boolean);
  737. begin
  738.   SetBooleanProperty(arch, 'F', auto);
  739. end;
  740.  
  741. procedure SevenZipCompressHeaders(Arch: I7zOutArchive; compress: boolean);
  742. begin
  743.   SetBooleanProperty(arch, 'HC', compress);
  744. end;
  745.  
  746. procedure SevenZipCompressHeadersFull(Arch: I7zOutArchive; compress: boolean);
  747. begin
  748.   SetBooleanProperty(arch, 'HCF', compress);
  749. end;
  750.  
  751. procedure SevenZipEncryptHeaders(Arch: I7zOutArchive; Encrypt: boolean);
  752. begin
  753.   SetBooleanProperty(arch, 'HE', Encrypt);
  754. end;
  755.  
  756. procedure SevenZipVolumeMode(Arch: I7zOutArchive; Mode: boolean);
  757. begin
  758.   SetBooleanProperty(arch, 'V', Mode);
  759. end;
  760.  
  761. type
  762.   T7zPlugin = class(TInterfacedObject)
  763.   private
  764.     FHandle: THandle;
  765.     FCreateObject: function(const clsid, iid :TGUID; var outObject): HRESULT; stdcall;
  766.   public
  767.     constructor Create(const lib: string); virtual;
  768.     destructor Destroy; override;
  769.     procedure CreateObject(const clsid, iid :TGUID; var obj);
  770.   end;
  771.  
  772.   T7zCodec = class(T7zPlugin, I7zCodec, ICompressProgressInfo)
  773.   private
  774.     FGetMethodProperty: function(index: Cardinal; propID: NMethodPropID; var value: OleVariant): HRESULT; stdcall;
  775.     FGetNumberOfMethods: function(numMethods: PCardinal): HRESULT; stdcall;
  776.     function GetNumberOfMethods: Cardinal;
  777.     function GetMethodProperty(index: Cardinal; propID: NMethodPropID): OleVariant;
  778.     function GetName(const index: integer): string;
  779.   protected
  780.     function SetRatioInfo(inSize, outSize: PInt64): HRESULT; stdcall;
  781.   public
  782.     function GetDecoder(const index: integer): ICompressCoder;
  783.     function GetEncoder(const index: integer): ICompressCoder;
  784.     constructor Create(const lib: string); override;
  785.     property MethodProperty[index: Cardinal; propID: NMethodPropID]: OleVariant read GetMethodProperty;
  786.     property NumberOfMethods: Cardinal read GetNumberOfMethods;
  787.     property Name[const index: integer]: string read GetName;
  788.   end;
  789.  
  790.   T7zArchive = class(T7zPlugin)
  791.   private
  792.     FGetHandlerProperty: function(propID: NArchive; var value: OleVariant): HRESULT; stdcall;
  793.     FClassId: TGUID;
  794.     procedure SetClassId(const classid: TGUID);
  795.     function GetClassId: TGUID;
  796.   public
  797.     function GetHandlerProperty(const propID: NArchive): OleVariant;
  798.     function GetLibStringProperty(const Index: NArchive): string;
  799.     function GetLibGUIDProperty(const Index: NArchive): TGUID;
  800.     constructor Create(const lib: string); override;
  801.     property HandlerProperty[const propID: NArchive]: OleVariant read GetHandlerProperty;
  802.     property Name: string index kName read GetLibStringProperty;
  803.     property ClassID: TGUID read GetClassId write SetClassId;
  804.     property Extension: string index kExtension read GetLibStringProperty;
  805.   end;
  806.  
  807.   T7zInArchive = class(T7zArchive, I7zInArchive, IProgress, IArchiveOpenCallback,
  808.     IArchiveExtractCallback, ICryptoGetTextPassword, IArchiveOpenVolumeCallback,
  809.     IArchiveOpenSetSubArchiveName)
  810.   private
  811.     FInArchive: IInArchive;
  812.     FPasswordCallback: T7zPasswordCallback;
  813.     FPasswordSender: Pointer;
  814.     FProgressCallback: T7zProgressCallback;
  815.     FProgressSender: Pointer;
  816.     FProgressExceptCallback: T7zProgressExceptCallback;
  817.     FProgressExceptSender: Pointer;
  818.     FStream: TStream;
  819.     FPasswordIsDefined: Boolean;
  820.     FPassword: UnicodeString;
  821.     FSubArchiveMode: Boolean;
  822.     FSubArchiveName: UnicodeString;
  823.     FExtractCallBack: T7zGetStreamCallBack;
  824.     FExtractSender: Pointer;
  825.     FExtractPath: string;
  826.     function GetInArchive: IInArchive;
  827.     function GetItemProp(const Item: Cardinal; prop: PROPID): OleVariant;
  828.   protected
  829.     // I7zInArchive
  830.     procedure OpenFile(const filename: string); stdcall;
  831.     procedure OpenStream(stream: IInStream); stdcall;
  832.     procedure Close; stdcall;
  833.     function GetNumberOfItems: Cardinal; stdcall;
  834.     function GetItemPath(const index: integer): UnicodeString; stdcall;
  835.     function GetItemName(const index: integer): UnicodeString; stdcall;
  836.     function GetItemSize(const index: integer): Cardinal; stdcall; stdcall;
  837.     function GetItemIsFolder(const index: integer): boolean; stdcall;
  838.     procedure ExtractItem(const item: Cardinal; Stream: TStream; test: longbool); stdcall;
  839.     procedure ExtractItems(items: PCardArray; count: cardinal; test: longbool; sender: pointer; callback: T7zGetStreamCallBack); stdcall;
  840.     procedure SetPasswordCallback(sender: Pointer; callback: T7zPasswordCallback); stdcall;
  841.     procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall;
  842.     procedure SetProgressExceptCallback(sender: Pointer; callback: T7zProgressExceptCallback); stdcall;
  843.     procedure ExtractAll(test: longbool; sender: pointer; callback: T7zGetStreamCallBack); stdcall;
  844.     procedure ExtractTo(const path: string); stdcall;
  845.     procedure SetPassword(const password: UnicodeString); stdcall;
  846.     // IArchiveOpenCallback
  847.     function SetTotal(files, bytes: PInt64): HRESULT; overload; stdcall;
  848.     function SetCompleted(files, bytes: PInt64): HRESULT; overload; stdcall;
  849.     // IProgress
  850.     function SetTotal(total: Int64): HRESULT;  overload; stdcall;
  851.     function SetCompleted(completeValue: PInt64): HRESULT; overload; stdcall;
  852.     // IArchiveExtractCallback
  853.     function GetStream(index: Cardinal; var outStream: ISequentialOutStream;
  854.       askExtractMode: NAskMode): HRESULT; overload; stdcall;
  855.     function PrepareOperation(askExtractMode: NAskMode): HRESULT; stdcall;
  856.     function SetOperationResult(resultEOperationResult: NExtOperationResult): HRESULT; overload; stdcall;
  857.     // ICryptoGetTextPassword
  858.     function CryptoGetTextPassword(var password: TBStr): HRESULT; stdcall;
  859.     // IArchiveOpenVolumeCallback
  860.     function GetProperty(propID: PROPID; var value: OleVariant): HRESULT; overload; stdcall;
  861.     function GetStream(const name: PWideChar; var inStream: IInStream): HRESULT; overload; stdcall;
  862.     // IArchiveOpenSetSubArchiveName
  863.     function SetSubArchiveName(name: PWideChar): HRESULT; stdcall;
  864.  
  865.   public
  866.     constructor Create(const lib: string); override;
  867.     destructor Destroy; override;
  868.     property InArchive: IInArchive read GetInArchive;
  869.   end;
  870.  
  871.   T7zOutArchive = class(T7zArchive, I7zOutArchive, IArchiveUpdateCallback, ICryptoGetTextPassword2)
  872.   private
  873.     FOutArchive: IOutArchive;
  874.     FBatchList: TObjectList;
  875.     FProgressCallback: T7zProgressCallback;
  876.     FProgressSender: Pointer;
  877.     FPassword: UnicodeString;
  878.     function GetOutArchive: IOutArchive;
  879.   protected
  880.     // I7zOutArchive
  881.     procedure AddStream(Stream: TStream; Ownership: TStreamOwnership;
  882.       Attributes: Cardinal; CreationTime, LastWriteTime: TFileTime;
  883.       const Path: UnicodeString; IsFolder, IsAnti: boolean); stdcall;
  884.     procedure AddFile(const Filename: TFileName; const Path: UnicodeString); stdcall;
  885.     procedure AddFiles(const Dir, Path, Willcards: string; recurse: boolean); stdcall;
  886.     procedure SaveToFile(const FileName: TFileName); stdcall;
  887.     procedure SaveToStream(stream: TStream); stdcall;
  888.     procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall;
  889.     procedure CrearBatch; stdcall;
  890.     procedure SetPassword(const password: UnicodeString); stdcall;
  891.     procedure SetPropertie(name: UnicodeString; value: OleVariant); stdcall;
  892.     // IProgress
  893.     function SetTotal(total: Int64): HRESULT; stdcall;
  894.     function SetCompleted(completeValue: PInt64): HRESULT; stdcall;
  895.     // IArchiveUpdateCallback
  896.     function GetUpdateItemInfo(index: Cardinal;
  897.         newData: PInteger; // 1 - new data, 0 - old data
  898.         newProperties: PInteger; // 1 - new properties, 0 - old properties
  899.         indexInArchive: PCardinal // -1 if there is no in archive, or if doesn't matter
  900.         ): HRESULT; stdcall;
  901.     function GetProperty(index: Cardinal; propID: PROPID; var value: OleVariant): HRESULT; stdcall;
  902.     function GetStream(index: Cardinal; var inStream: ISequentialInStream): HRESULT; stdcall;
  903.     function SetOperationResult(operationResult: Integer): HRESULT; stdcall;
  904.     // ICryptoGetTextPassword2
  905.     function CryptoGetTextPassword2(passwordIsDefined: PInteger; var password: TBStr): HRESULT; stdcall;
  906.   public
  907.     constructor Create(const lib: string); override;
  908.     destructor Destroy; override;
  909.     property OutArchive: IOutArchive read GetOutArchive;
  910.   end;
  911.  
  912. function CreateInArchive(const classid: TGUID): I7zInArchive;
  913. begin
  914.   Result := T7zInArchive.Create(WorkPath + '7z.dll');
  915.   Result.ClassId := classid;
  916. end;
  917.  
  918. function CreateOutArchive(const classid: TGUID): I7zOutArchive;
  919. begin
  920.   Result := T7zOutArchive.Create(WorkPath + '7z.dll');
  921.   Result.ClassId := classid;
  922. end;
  923.  
  924. { T7zPlugin }
  925.  
  926. constructor T7zPlugin.Create(const lib: string);
  927. begin
  928.   FHandle := LoadLibrary(PChar(lib));
  929.   if FHandle =  then
  930.     raise exception.CreateFmt('Error loading library %s', [lib]);
  931.   FCreateObject := GetProcAddress(FHandle, 'CreateObject');
  932.   if not (Assigned(FCreateObject)) then
  933.   begin
  934.     FreeLibrary(FHandle);
  935.     raise Exception.CreateFmt('%s is not a 7z library', [lib]);
  936.   end;
  937. end;
  938.  
  939. destructor T7zPlugin.Destroy;
  940. begin
  941.   FreeLibrary(FHandle);
  942.   inherited;
  943. end;
  944.  
  945. procedure T7zPlugin.CreateObject(const clsid, iid: TGUID; var obj);
  946. var
  947.   hr: HRESULT;
  948. begin
  949.   hr := FCreateObject(clsid, iid, obj);
  950.   if failed(hr) then
  951.     raise Exception.Create(SysErrorMessage(hr));
  952. end;
  953.  
  954. { T7zCodec }
  955.  
  956. constructor T7zCodec.Create(const lib: string);
  957. begin
  958.   inherited;
  959.   FGetMethodProperty := GetProcAddress(FHandle, 'GetMethodProperty');
  960.   FGetNumberOfMethods := GetProcAddress(FHandle, 'GetNumberOfMethods');
  961.   if not (Assigned(FGetMethodProperty) and Assigned(FGetNumberOfMethods)) then
  962.   begin
  963.     FreeLibrary(FHandle);
  964.     raise Exception.CreateFmt('%s is not a codec library', [lib]);
  965.   end;
  966. end;
  967.  
  968. function T7zCodec.GetDecoder(const index: integer): ICompressCoder;
  969. var
  970.   v: OleVariant;
  971. begin
  972.   v := MethodProperty[index, kDecoder];
  973.   CreateObject(TPropVariant(v).puuid^, ICompressCoder, Result);
  974. end;
  975.  
  976. function T7zCodec.GetEncoder(const index: integer): ICompressCoder;
  977. var
  978.   v: OleVariant;
  979. begin
  980.   v := MethodProperty[index, kEncoder];
  981.   CreateObject(TPropVariant(v).puuid^, ICompressCoder, Result);
  982. end;
  983.  
  984. function T7zCodec.GetMethodProperty(index: Cardinal;
  985.   propID: NMethodPropID): OleVariant;
  986. var
  987.   hr: HRESULT;
  988. begin
  989.   hr := FGetMethodProperty(index, propID, Result);
  990.   if Failed(hr) then
  991.     raise Exception.Create(SysErrorMessage(hr));
  992. end;
  993.  
  994. function T7zCodec.GetName(const index: integer): string;
  995. begin
  996.   Result := MethodProperty[index, kName_];
  997. end;
  998.  
  999. function T7zCodec.GetNumberOfMethods: Cardinal;
  1000. var
  1001.   hr: HRESULT;
  1002. begin
  1003.   hr := FGetNumberOfMethods(@Result);
  1004.   if Failed(hr) then
  1005.     raise Exception.Create(SysErrorMessage(hr));
  1006. end;
  1007.  
  1008. function T7zCodec.SetRatioInfo(inSize, outSize: PInt64): HRESULT;
  1009. begin
  1010.   Result := S_OK;
  1011. end;
  1012.  
  1013. { T7zInArchive }
  1014.  
  1015. procedure T7zInArchive.Close; stdcall;
  1016. begin
  1017.   FPasswordIsDefined := false;
  1018.   FSubArchiveMode := false;
  1019.   FInArchive.Close;
  1020.   FInArchive := nil;
  1021. end;
  1022.  
  1023. constructor T7zInArchive.Create(const lib: string);
  1024. begin
  1025.   inherited;
  1026.   FPasswordCallback := nil;
  1027.   FPasswordSender := nil;
  1028.   FPasswordIsDefined := false;
  1029.   FSubArchiveMode := false;
  1030.   FExtractCallBack := nil;
  1031.   FExtractSender := nil;
  1032. end;
  1033.  
  1034. destructor T7zInArchive.Destroy;
  1035. begin
  1036.   FInArchive := nil;
  1037.   inherited;
  1038. end;
  1039.  
  1040. function T7zInArchive.GetInArchive: IInArchive;
  1041. begin
  1042.   if FInArchive = nil then
  1043.     CreateObject(ClassID, IInArchive, FInArchive);
  1044.   Result := FInArchive;
  1045. end;
  1046.  
  1047. function T7zInArchive.GetItemPath(const index: integer): UnicodeString; stdcall;
  1048. begin
  1049.   Result := UnicodeString(GetItemProp(index, kpidPath));
  1050. end;
  1051.  
  1052. function T7zInArchive.GetNumberOfItems: Cardinal; stdcall;
  1053. begin
  1054.   RINOK(FInArchive.GetNumberOfItems(Result));
  1055. end;
  1056.  
  1057. procedure T7zInArchive.OpenFile(const filename: string); stdcall;
  1058. var
  1059.   strm: IInStream;
  1060. begin
  1061.   strm := T7zStream.Create(TFileStream.Create(filename, fmOpenRead or fmShareDenyNone), soOwned);
  1062.   try
  1063.     RINOK(
  1064.       InArchive.Open(
  1065.         strm,
  1066.           @MAXCHECK, self as IArchiveOpenCallBack
  1067.         )
  1068.       );
  1069.   finally
  1070.     strm := nil;
  1071.   end;
  1072. end;
  1073.  
  1074. procedure T7zInArchive.OpenStream(stream: IInStream); stdcall;
  1075. begin
  1076.   RINOK(InArchive.Open(stream, @MAXCHECK, self as IArchiveOpenCallBack));
  1077. end;
  1078.  
  1079. function T7zInArchive.GetItemIsFolder(const index: integer): boolean; stdcall;
  1080. begin
  1081.   Result := Boolean(GetItemProp(index, kpidIsFolder));
  1082. end;
  1083.  
  1084. function T7zInArchive.GetItemProp(const Item: Cardinal;
  1085.   prop: PROPID): OleVariant;
  1086. begin
  1087.   FInArchive.GetProperty(Item, prop, Result);
  1088. end;
  1089.  
  1090. procedure T7zInArchive.ExtractItem(const item: Cardinal; Stream: TStream; test: longbool); stdcall;
  1091. begin
  1092.   FStream := Stream;
  1093.   try
  1094.     if test then
  1095.       RINOK(FInArchive.Extract(@item, , , self as IArchiveExtractCallback)) else
  1096.       RINOK(FInArchive.Extract(@item, , , self as IArchiveExtractCallback));
  1097.   finally
  1098.     FStream := nil;
  1099.   end;
  1100. end;
  1101.  
  1102. function T7zInArchive.GetStream(index: Cardinal;
  1103.   var outStream: ISequentialOutStream; askExtractMode: NAskMode): HRESULT;
  1104. var
  1105.   nPath: string;
  1106.   nDefFileAttr: Cardinal;
  1107.   nFileStream: TFileStream;
  1108.   nECR: NECallBack;
  1109. begin
  1110.   Result := S_FALSE;
  1111.   if askExtractMode = kExtract then
  1112.   begin
  1113.     if FStream <> nil then
  1114.       outStream := T7zStream.Create(FStream, soReference) as ISequentialOutStream
  1115.     else if assigned(FExtractCallback) then
  1116.     begin
  1117.       Result := FExtractCallBack(FExtractSender, index, outStream);
  1118.       Exit;
  1119.     end
  1120.     else if FExtractPath <> '' then
  1121.     begin
  1122.       if GetItemIsFolder(index) then
  1123.       begin
  1124.         nPath := FExtractPath + GetItemPath(index);
  1125.         ForceDirectories(nPath);
  1126.       end
  1127.       else
  1128.       begin
  1129.         nPath := FExtractPath + GetItemPath(index);
  1130.         ForceDirectories(ExtractFilePath(nPath));
  1131.         nDefFileAttr := ;
  1132.         if FileExists(nPath) then
  1133.         begin
  1134.           nDefFileAttr := GetFileAttributes(PChar(nPath));
  1135.           if nDefFileAttr <> FILE_ATTRIBUTE_NORMAL then
  1136.             SetFileAttributes(PChar(nPath), FILE_ATTRIBUTE_NORMAL);
  1137.         end;
  1138.  
  1139.         repeat
  1140.           try
  1141.             nFileStream := TFileStream.Create(nPath, fmCreate);
  1142.           except
  1143.             FreeAndNil(nFileStream);
  1144.             if not Assigned(FProgressExceptCallback) then
  1145.               nECR := EC_CANCEL
  1146.             else
  1147.               nECR := FProgressExceptCallback(FProgressExceptSender, nPath);
  1148.           end;
  1149.         until (nFileStream <> nil) or (nECR <> EC_RETRY);
  1150.         if nFileStream = nil then
  1151.         begin
  1152.           if nECR = EC_CANCEL then
  1153.             Exit;
  1154.         end
  1155.         else
  1156.         begin
  1157.           outStream := T7zStream.Create(nFileStream, soOwned);
  1158.           if (nDefFileAttr <> ) and (nDefFileAttr <> FILE_ATTRIBUTE_NORMAL) then
  1159.             SetFileAttributes(PChar(nPath), nDefFileAttr);
  1160.         end;
  1161.       end;
  1162.     end;
  1163.   end;
  1164.   Result := S_OK;
  1165. end;
  1166.  
  1167. function T7zInArchive.PrepareOperation(askExtractMode: NAskMode): HRESULT;
  1168. begin
  1169.   Result := S_OK;
  1170. end;
  1171.  
  1172. function T7zInArchive.SetCompleted(completeValue: PInt64): HRESULT;
  1173. begin
  1174.   if Assigned(FProgressCallback) and (completeValue <> nil) then
  1175.     Result := FProgressCallback(FProgressSender, false, completeValue^) else
  1176.     Result := S_OK;
  1177. end;
  1178.  
  1179. function T7zInArchive.SetCompleted(files, bytes: PInt64): HRESULT;
  1180. begin
  1181.   Result := S_OK;
  1182. end;
  1183.  
  1184. function T7zInArchive.SetOperationResult(
  1185.   resultEOperationResult: NExtOperationResult): HRESULT;
  1186. begin
  1187.   Result := S_OK;
  1188. end;
  1189.  
  1190. function T7zInArchive.SetTotal(total: Int64): HRESULT;
  1191. begin
  1192.   if Assigned(FProgressCallback) then
  1193.     Result := FProgressCallback(FProgressSender, true, total) else
  1194.     Result := S_OK;
  1195. end;
  1196.  
  1197. function T7zInArchive.SetTotal(files, bytes: PInt64): HRESULT;
  1198. begin
  1199.   Result := S_OK;
  1200. end;
  1201.  
  1202. function T7zInArchive.CryptoGetTextPassword(var password: TBStr): HRESULT;
  1203. var
  1204.   wpass: UnicodeString;
  1205. begin
  1206.   if FPasswordIsDefined then
  1207.   begin
  1208.     password := SysAllocString(PWideChar(FPassword));
  1209.     Result := S_OK;
  1210.   end else
  1211.   if Assigned(FPasswordCallback) then
  1212.   begin
  1213.     Result := FPasswordCallBack(FPasswordSender, wpass);
  1214.     if Result = S_OK then
  1215.     begin
  1216.       password := SysAllocString(PWideChar(wpass));
  1217.       FPasswordIsDefined := True;
  1218.       FPassword := wpass;
  1219.     end;
  1220.   end else
  1221.     Result := S_FALSE;
  1222. end;
  1223.  
  1224. function T7zInArchive.GetProperty(propID: PROPID;
  1225.   var value: OleVariant): HRESULT;
  1226. begin
  1227.   Result := S_OK;
  1228. end;
  1229.  
  1230. function T7zInArchive.GetStream(const name: PWideChar;
  1231.   var inStream: IInStream): HRESULT;
  1232. begin
  1233.   Result := S_OK;
  1234. end;
  1235.  
  1236. procedure T7zInArchive.SetPasswordCallback(sender: Pointer;
  1237.   callback: T7zPasswordCallback); stdcall;
  1238. begin
  1239.   FPasswordSender := sender;
  1240.   FPasswordCallback := callback;
  1241. end;
  1242.  
  1243. function T7zInArchive.SetSubArchiveName(name: PWideChar): HRESULT;
  1244. begin
  1245.   FSubArchiveMode := true;
  1246.   FSubArchiveName := name;
  1247.   Result := S_OK;
  1248. end;
  1249.  
  1250. function T7zInArchive.GetItemName(const index: integer): UnicodeString; stdcall;
  1251. begin
  1252.   Result := UnicodeString(GetItemProp(index, kpidName));
  1253. end;
  1254.  
  1255. function T7zInArchive.GetItemSize(const index: integer): Cardinal; stdcall;
  1256. begin
  1257.   Result := Cardinal(GetItemProp(index, kpidSize));
  1258. end;
  1259.  
  1260. procedure T7zInArchive.ExtractItems(items: PCardArray; count: cardinal; test: longbool;
  1261.   sender: pointer; callback: T7zGetStreamCallBack); stdcall;
  1262. begin
  1263.   FExtractCallBack := callback;
  1264.   FExtractSender := sender;
  1265.   try
  1266.     if test then
  1267.       RINOK(FInArchive.Extract(items, count, , self as IArchiveExtractCallback)) else
  1268.       RINOK(FInArchive.Extract(items, count, , self as IArchiveExtractCallback));
  1269.   finally
  1270.     FExtractCallBack := nil;
  1271.     FExtractSender := nil;
  1272.   end;
  1273. end;
  1274.  
  1275. procedure T7zInArchive.SetProgressCallback(sender: Pointer;
  1276.   callback: T7zProgressCallback); stdcall;
  1277. begin
  1278.   FProgressSender := sender;
  1279.   FProgressCallback := callback;
  1280. end;
  1281.  
  1282. procedure T7zInArchive.SetProgressExceptCallback(sender: Pointer;
  1283.   callback: T7zProgressExceptCallback);
  1284. begin
  1285.   FProgressExceptSender := sender;
  1286.   FProgressExceptCallback := callback;
  1287. end;
  1288.  
  1289. procedure T7zInArchive.ExtractAll(test: longbool; sender: pointer;
  1290.   callback: T7zGetStreamCallBack);
  1291. begin
  1292.   FExtractCallBack := callback;
  1293.   FExtractSender := sender;
  1294.   try
  1295.     if test then
  1296.       RINOK(FInArchive.Extract(nil, $FFFFFFFF, , self as IArchiveExtractCallback)) else
  1297.       RINOK(FInArchive.Extract(nil, $FFFFFFFF, , self as IArchiveExtractCallback));
  1298.   finally
  1299.     FExtractCallBack := nil;
  1300.     FExtractSender := nil;
  1301.   end;
  1302. end;
  1303.  
  1304. procedure T7zInArchive.ExtractTo(const path: string);
  1305. begin
  1306.   FExtractPath := IncludeTrailingPathDelimiter(path);
  1307.   try
  1308.     RINOK(FInArchive.Extract(nil, $FFFFFFFF, , self as IArchiveExtractCallback));
  1309.   finally
  1310.     FExtractPath := '';
  1311.   end;
  1312. end;
  1313.  
  1314. procedure T7zInArchive.SetPassword(const password: UnicodeString);
  1315. begin
  1316.   FPassword := password;
  1317.   FPasswordIsDefined :=  FPassword <> '';
  1318. end;
  1319.  
  1320. { T7zArchive }
  1321.  
  1322. constructor T7zArchive.Create(const lib: string);
  1323. begin
  1324.   inherited;
  1325.   FGetHandlerProperty := GetProcAddress(FHandle, 'GetHandlerProperty');
  1326.   if not Assigned(FGetHandlerProperty) then
  1327.   begin
  1328.     FreeLibrary(FHandle);
  1329.     raise Exception.CreateFmt('%s is not a Format library', [lib]);
  1330.   end;
  1331.   FClassId := GUID_NULL;
  1332. end;
  1333.  
  1334. function T7zArchive.GetClassId: TGUID;
  1335. begin
  1336.   Result := FClassId;
  1337. end;
  1338.  
  1339. function T7zArchive.GetHandlerProperty(const propID: NArchive): OleVariant;
  1340. var
  1341.   hr: HRESULT;
  1342. begin
  1343.   hr := FGetHandlerProperty(propID, Result);
  1344.   if Failed(hr) then
  1345.     raise Exception.Create(SysErrorMessage(hr));
  1346. end;
  1347.  
  1348. function T7zArchive.GetLibGUIDProperty(const Index: NArchive): TGUID;
  1349. var
  1350.   v: OleVariant;
  1351. begin
  1352.   v := HandlerProperty[index];
  1353.   Result := TPropVariant(v).puuid^;
  1354. end;
  1355.  
  1356. function T7zArchive.GetLibStringProperty(const Index: NArchive): string;
  1357. begin
  1358.   Result := HandlerProperty[Index];
  1359. end;
  1360.  
  1361. procedure T7zArchive.SetClassId(const classid: TGUID);
  1362. begin
  1363.   FClassId := classid;
  1364. end;
  1365.  
  1366. { T7zStream }
  1367.  
  1368. constructor T7zStream.Create(Stream: TStream; Ownership: TStreamOwnership);
  1369. begin
  1370.   inherited Create;
  1371.   FStream := Stream;
  1372.   FOwnership := Ownership;
  1373. end;
  1374.  
  1375. destructor T7zStream.destroy;
  1376. begin
  1377.   if FOwnership = soOwned then
  1378.   begin
  1379.     FStream.Free;
  1380.     FStream := nil;
  1381.   end;
  1382.   inherited;
  1383. end;
  1384.  
  1385. function T7zStream.Flush: HRESULT;
  1386. begin
  1387.   Result := S_OK;
  1388. end;
  1389.  
  1390. function T7zStream.GetSize(size: PInt64): HRESULT;
  1391. begin
  1392.   if size <> nil then
  1393.     size^ := FStream.Size;
  1394.   Result := S_OK;
  1395. end;
  1396.  
  1397. function T7zStream.Read(data: Pointer; size: Cardinal;
  1398.   processedSize: PCardinal): HRESULT;
  1399. var
  1400.   len: integer;
  1401. begin
  1402.   len := FStream.Read(data^, size);
  1403.   if processedSize <> nil then
  1404.     processedSize^ := len;
  1405.   Result := S_OK;
  1406. end;
  1407.  
  1408. function T7zStream.Seek(offset: Int64; seekOrigin: Cardinal;
  1409.   newPosition: PInt64): HRESULT;
  1410. begin
  1411.   FStream.Seek(offset, TSeekOrigin(seekOrigin));
  1412.   if newPosition <> nil then
  1413.     newPosition^ := FStream.Position;
  1414.   Result := S_OK;
  1415. end;
  1416.  
  1417. function T7zStream.SetSize(newSize: Int64): HRESULT;
  1418. begin
  1419.   FStream.Size := newSize;
  1420.   Result := S_OK;
  1421. end;
  1422.  
  1423. function T7zStream.Write(data: Pointer; size: Cardinal;
  1424.   processedSize: PCardinal): HRESULT;
  1425. var
  1426.   len: integer;
  1427. begin
  1428.   len := FStream.Write(data^, size);
  1429.   if processedSize <> nil then
  1430.     processedSize^ := len;
  1431.   Result := S_OK;
  1432. end;
  1433.  
  1434. type
  1435.   TSourceMode = (smStream, smFile);
  1436.  
  1437.   T7zBatchItem = class
  1438.     SourceMode: TSourceMode;
  1439.     Stream: TStream;
  1440.     Attributes: Cardinal;
  1441.     CreationTime, LastWriteTime: TFileTime;
  1442.     Path: UnicodeString;
  1443.     IsFolder, IsAnti: boolean;
  1444.     FileName: TFileName;
  1445.     Ownership: TStreamOwnership;
  1446.     Size: Cardinal;
  1447.     destructor Destroy; override;
  1448.   end;
  1449.  
  1450. destructor T7zBatchItem.Destroy;
  1451. begin
  1452.   if (Ownership = soOwned) and (Stream <> nil) then
  1453.     Stream.Free;
  1454.   inherited;
  1455. end;
  1456.  
  1457. { T7zOutArchive }
  1458.  
  1459. procedure T7zOutArchive.AddFile(const Filename: TFileName; const Path: UnicodeString);
  1460. var
  1461.   item: T7zBatchItem;
  1462.   Handle: THandle;
  1463. begin
  1464.   if not FileExists(Filename) then exit;
  1465.   item := T7zBatchItem.Create;
  1466.   Item.SourceMode := smFile;
  1467.   item.Stream := nil;
  1468.   item.FileName := Filename;
  1469.   item.Path := Path;
  1470.   Handle := FileOpen(Filename, fmOpenRead or fmShareDenyNone);
  1471.   GetFileTime(Handle, @item.CreationTime, nil, @item.LastWriteTime);
  1472.   item.Size := GetFileSize(Handle, nil);
  1473.   CloseHandle(Handle);
  1474.   item.Attributes := GetFileAttributes(PChar(Filename));
  1475.   item.IsFolder := false;
  1476.   item.IsAnti := False;
  1477.   item.Ownership := soOwned;
  1478.   FBatchList.Add(item);
  1479. end;
  1480.  
  1481. procedure T7zOutArchive.AddFiles(const Dir, Path, Willcards: string; recurse: boolean);
  1482. var
  1483.   lencut: integer;
  1484.   willlist: TStringList;
  1485.   zedir: string;
  1486.  
  1487.   procedure Traverse(p: string);
  1488.   var
  1489.     f: TSearchRec;
  1490.     i: integer;
  1491.     item: T7zBatchItem;
  1492.   begin
  1493.     if recurse then
  1494.     begin
  1495.       if FindFirst(p + '*.*', faDirectory, f) =  then
  1496.       repeat
  1497.         if (f.Name[] <> '.') then
  1498.           Traverse(IncludeTrailingPathDelimiter(p + f.Name));
  1499.       until FindNext(f) <> ;
  1500.       SysUtils.FindClose(f);
  1501.     end;
  1502.  
  1503.     for i :=  to willlist.Count -  do
  1504.     begin
  1505.       if FindFirst(p + willlist[i], faReadOnly or faHidden or faSysFile or faArchive, f) =  then
  1506.       repeat
  1507.         item := T7zBatchItem.Create;
  1508.         Item.SourceMode := smFile;
  1509.         item.Stream := nil;
  1510.         item.FileName := p + f.Name;
  1511.         item.Path := copy(item.FileName, lencut, length(item.FileName) - lencut + );
  1512.         if path <> '' then
  1513.           item.Path := IncludeTrailingPathDelimiter(path) + item.Path;
  1514.         item.CreationTime := f.FindData.ftCreationTime;
  1515.         item.LastWriteTime := f.FindData.ftLastWriteTime;
  1516.         item.Attributes := f.FindData.dwFileAttributes;
  1517.         item.Size := f.Size;
  1518.         item.IsFolder := false;
  1519.         item.IsAnti := False;
  1520.         item.Ownership := soOwned;
  1521.         FBatchList.Add(item);
  1522.       until FindNext(f) <> ;
  1523.       SysUtils.FindClose(f);
  1524.     end;
  1525.   end;
  1526.  
  1527.   procedure _Delimiter;
  1528.   var
  1529.     i, s, x, l: Integer;
  1530.     nStr: string;
  1531.   begin
  1532.     s := ;
  1533.     l := Length(Willcards);
  1534.     for i :=  to l do
  1535.     begin
  1536.       if Willcards[i] = ';' then
  1537.       begin
  1538.         willlist.Add(Copy(Willcards, s, i - s));
  1539.         s := i + ;
  1540.       end;
  1541.     end;
  1542.     if s < l then
  1543.       willlist.Add(Copy(Willcards, s, l - s + ));
  1544.   end;
  1545.  
  1546. begin
  1547.   willlist := TStringList.Create;
  1548.   try
  1549.     _Delimiter;
  1550.     zedir := IncludeTrailingPathDelimiter(Dir);
  1551.     lencut := Length(zedir) + ;
  1552.     Traverse(zedir);
  1553.   finally
  1554.     willlist.Free;
  1555.   end;
  1556. end;
  1557.  
  1558. procedure T7zOutArchive.AddStream(Stream: TStream; Ownership: TStreamOwnership;
  1559.   Attributes: Cardinal; CreationTime, LastWriteTime: TFileTime;
  1560.   const Path: UnicodeString; IsFolder, IsAnti: boolean); stdcall;
  1561. var
  1562.   item: T7zBatchItem;
  1563. begin
  1564.   item := T7zBatchItem.Create;
  1565.   Item.SourceMode := smStream;
  1566.   item.Attributes := Attributes;
  1567.   item.CreationTime := CreationTime;
  1568.   item.LastWriteTime := LastWriteTime;
  1569.   item.Path := Path;
  1570.   item.IsFolder := IsFolder;
  1571.   item.IsAnti := IsAnti;
  1572.   item.Stream := Stream;
  1573.   item.Size := Stream.Size;
  1574.   item.Ownership := Ownership;
  1575.   FBatchList.Add(item);
  1576. end;
  1577.  
  1578. procedure T7zOutArchive.CrearBatch;
  1579. begin
  1580.   FBatchList.Clear;
  1581. end;
  1582.  
  1583. constructor T7zOutArchive.Create(const lib: string);
  1584. begin
  1585.   inherited;
  1586.   FBatchList := TObjectList.Create;
  1587.   FProgressCallback := nil;
  1588.   FProgressSender := nil;
  1589. end;
  1590.  
  1591. function T7zOutArchive.CryptoGetTextPassword2(passwordIsDefined: PInteger;
  1592.   var password: TBStr): HRESULT;
  1593. begin
  1594.   if FPassword <> '' then
  1595.   begin
  1596.    passwordIsDefined^ := ;
  1597.    password := SysAllocString(PWideChar(FPassword));
  1598.   end else
  1599.     passwordIsDefined^ := ;
  1600.   Result := S_OK;
  1601. end;
  1602.  
  1603. destructor T7zOutArchive.Destroy;
  1604. begin
  1605.   FOutArchive := nil;
  1606.   FBatchList.Free;
  1607.   inherited;
  1608. end;
  1609.  
  1610. function T7zOutArchive.GetOutArchive: IOutArchive;
  1611. begin
  1612.   if FOutArchive = nil then
  1613.     CreateObject(ClassID, IOutArchive, FOutArchive);
  1614.   Result := FOutArchive;
  1615. end;
  1616.  
  1617. function T7zOutArchive.GetProperty(index: Cardinal; propID: PROPID;
  1618.   var value: OleVariant): HRESULT;
  1619. var
  1620.   item: T7zBatchItem;
  1621. begin
  1622.   item := T7zBatchItem(FBatchList[index]);
  1623.   case propID of
  1624.     kpidAttributes:
  1625.       begin
  1626.         TPropVariant(Value).vt := VT_UI4;
  1627.         TPropVariant(Value).ulVal := item.Attributes;
  1628.       end;
  1629.     kpidLastWriteTime:
  1630.       begin
  1631.         TPropVariant(value).vt := VT_FILETIME;
  1632.         TPropVariant(value).filetime := item.LastWriteTime;
  1633.       end;
  1634.     kpidPath:
  1635.       begin
  1636.         if item.Path <> '' then
  1637.           value := item.Path;
  1638.       end;
  1639.     kpidIsFolder: Value := item.IsFolder;
  1640.     kpidSize:
  1641.       begin
  1642.         TPropVariant(Value).vt := VT_UI8;
  1643.         TPropVariant(Value).uhVal.QuadPart := item.Size;
  1644.       end;
  1645.     kpidCreationTime:
  1646.       begin
  1647.         TPropVariant(value).vt := VT_FILETIME;
  1648.         TPropVariant(value).filetime := item.CreationTime;
  1649.       end;
  1650.     kpidIsAnti: value := item.IsAnti;
  1651.   else
  1652.    // beep(0,0);
  1653.   end;
  1654.   Result := S_OK;
  1655. end;
  1656.  
  1657. function T7zOutArchive.GetStream(index: Cardinal;
  1658.   var inStream: ISequentialInStream): HRESULT;
  1659. var
  1660.   item: T7zBatchItem;
  1661. begin
  1662.   item := T7zBatchItem(FBatchList[index]);
  1663.   case item.SourceMode of
  1664.     smFile: inStream := T7zStream.Create(TFileStream.Create(item.FileName, fmOpenRead or fmShareDenyNone), soOwned);
  1665.     smStream:
  1666.       begin
  1667.         item.Stream.Seek(, soFromBeginning);
  1668.         inStream := T7zStream.Create(item.Stream);
  1669.       end;
  1670.   end;
  1671.   Result := S_OK;
  1672. end;
  1673.  
  1674. function T7zOutArchive.GetUpdateItemInfo(index: Cardinal; newData,
  1675.   newProperties: PInteger; indexInArchive: PCardinal): HRESULT;
  1676. begin
  1677.   newData^ := ;
  1678.   newProperties^ := ;
  1679.   indexInArchive^ := CArdinal(-);
  1680.   Result := S_OK;
  1681. end;
  1682.  
  1683. procedure T7zOutArchive.SaveToFile(const FileName: TFileName);
  1684. var
  1685.   f: TFileStream;
  1686. begin
  1687.   f := TFileStream.Create(FileName, fmCreate);
  1688.   try
  1689.     SaveToStream(f);
  1690.   finally
  1691.     f.free;
  1692.   end;
  1693. end;
  1694.  
  1695. procedure T7zOutArchive.SaveToStream(stream: TStream);
  1696. var
  1697.   strm: ISequentialOutStream;
  1698. begin
  1699.   strm := T7zStream.Create(stream);
  1700.   try
  1701.     RINOK(OutArchive.UpdateItems(strm, FBatchList.Count, self as IArchiveUpdateCallback));
  1702.   finally
  1703.     strm := nil;
  1704.   end;
  1705. end;
  1706.  
  1707. function T7zOutArchive.SetCompleted(completeValue: PInt64): HRESULT;
  1708. begin
  1709.   if Assigned(FProgressCallback) and (completeValue <> nil) then
  1710.     Result := FProgressCallback(FProgressSender, false, completeValue^) else
  1711.     Result := S_OK;
  1712. end;
  1713.  
  1714. function T7zOutArchive.SetOperationResult(
  1715.   operationResult: Integer): HRESULT;
  1716. begin
  1717.   Result := S_OK;
  1718. end;
  1719.  
  1720. procedure T7zOutArchive.SetPassword(const password: UnicodeString);
  1721. begin
  1722.   FPassword := password;
  1723. end;
  1724.  
  1725. procedure T7zOutArchive.SetProgressCallback(sender: Pointer;
  1726.   callback: T7zProgressCallback);
  1727. begin
  1728.   FProgressCallback := callback;
  1729.   FProgressSender := sender;
  1730. end;
  1731.  
  1732. procedure T7zOutArchive.SetPropertie(name: UnicodeString;
  1733.   value: OleVariant);
  1734. var
  1735.   intf: ISetProperties;
  1736.   p: PWideChar;
  1737. begin
  1738.   intf := OutArchive as ISetProperties;
  1739.   p := PWideChar(name);
  1740.   RINOK(intf.SetProperties(@p, @TPropVariant(value), ));
  1741. end;
  1742.  
  1743. function T7zOutArchive.SetTotal(total: Int64): HRESULT;
  1744. begin
  1745.   if Assigned(FProgressCallback) then
  1746.     Result := FProgressCallback(FProgressSender, true, total) else
  1747.     Result := S_OK;
  1748. end;
  1749.  
  1750. initialization
  1751.   WorkPath := '';
  1752.  
  1753. end.

SevenZip.pas BUG修改版 - 20160613的更多相关文章

  1. sqm(sqlmapGUI) pcat修改版

    sqlmap是一款开源的注入工具,支持几乎所有的数据库,支持get/post/cookie注入,支持错误回显注入/盲注,还有其他多种注入方法. 支持代理,指纹识别技术判断数据库 .而sqm(sqlma ...

  2. Indy 10.5.8 for Delphi and Lazarus 修改版(2011)

    Indy 10.5.8 for Delphi and Lazarus 修改版(2011)    Internet Direct(Indy)是一组开放源代码的Internet组件,涵盖了几乎所有流行的I ...

  3. Perl实用中文处理步骤（修改版）

    发信人: FenRagwort (泽), 信区: Perl标  题: Perl实用中文处理步骤(修改版)发信站: 水木社区 (Mon Feb 14 12:52:14 2011), 转信 (修改版 感谢 ...

  4. 【LINT】cpplint修改版：自定义编码风格检查工具lint

    github:https://github.com/skullboyer/code-check Code Check 本仓介绍的内容涉及代码静态检查和编码风格检查 但主要放在编码风格检查,lint是基 ...

  5. Medoo个人修改版

    Medoo是一款轻量级的php数据库操作类,下面不会介绍Medoo的使用方法,想学习Medoo请前往官网自学:http://medoo.in/ 在接触Medoo之前,一直是用自己写的php数据库操作类 ...

  6. Android 仿美团网,大众点评购买框悬浮效果之修改版

    转帖请注明本文出自xiaanming的博客(http://blog.csdn.net/xiaanming/article/details/17761431),请尊重他人的辛勤劳动成果,谢谢! 我之前写 ...

  7. 黄聪：WordPress图片插件：Auto Highslide修改版（转）

    一直以来很多人都很喜欢我博客使用的图片插件,因为我用的跟原版是有些不同的,效果比原版的要好,他有白色遮罩层,可以直观的知道上下翻图片和幻灯片放映模式.很多人使用原版之后发现我用的更加帅一些,于是很多人 ...

  8. 转载：Eclipse+Spket插件+ExtJs4修改版提供代码提示功能[图]

    转载:Eclipse+Spket插件+ExtJs4修改版提供代码提示功能[图] ExtJs是一种主要用于创建前端用户界面,是一个基本与后台技术无关的前端ajax框架.功能丰富,无人能出其右.无论是界面 ...

  9. 若快打码平台python开发文档修改版

    一.打码的作用 在进行爬虫过程中,部分网站的登录验证码是比较简单的,例如四个英文数字随机组合而成的验证码,有的是全数字随机组成的验证码,有的是全中文随机组成的验证码.为了爬虫进行自动化,需要解决自动登 ...

随机推荐

  1. Android 自动化测试—robotium(八) 拖拽

    本文来源于:http://xiaomaozi.blog.51cto.com/925779/933056 SeekBar控件 代码实现:http://luwenjie.blog.51cto.com/92 ...

  2. 疯狂java学习笔记之面向对象(三) - 方法所属性和值传递

    方法的所属性: 从语法的角度来看:方法必须定义在类中 方法要么属于类本身(static修饰),要么属于实例 -- 到底是属于类还是属于对象? 有无static修饰 调用方法时:必须有主调对象(主语,调 ...

  3. 前端构建之gulp与常用插件

    gulp是什么? http://gulpjs.com/ 相信你会明白的! 与著名的构建工具grunt相比,有什么优势呢? 易于使用,代码优于配置 高效,不会产生过多的中间文件,减少I/O压力 易于学习 ...

  4. div基础

    1. 写在后面的样式优于前面,会把前面的覆盖掉! 2.三角形的造法:width:0; height:0;然后设置border-left   border-right  border-top  bord ...

  5. Android 模糊效果

    (1)FastBlur http://www.cnblogs.com/CharlesGrant/p/4813735.html (2)StackBlur 基于RenderScript,StackBlur ...

  6. POJ 3320 尺取法，Hash，map标记

    1.POJ 3320 2.链接:http://poj.org/problem?id=3320 3.总结:尺取法,Hash,map标记 看书复习,p页书,一页有一个知识点,连续看求最少多少页看完所有知识 ...

  7. Android控件属性大全(转)

    http://blog.csdn.net/pku_android/article/details/7365685 LinearLayout         线性布局        子元素任意: Tab ...

  8. OBject copy 和retain区别

    @interface Person : NSObject //retian : release 旧值,retain 新值 @property(nonatomic,retain) Book *book; ...

  9. 手机访问pc网站自动跳转手机端网站代码

    <SCRIPT LANGUAGE="JavaScript">function mobile_device_detect(url){        var thisOS= ...

  10. ckeditor简单的演示

    先把ckeditor文件添加到项目中 然后在页面上引用 <!DOCTYPE html> <html xmlns="http://www.w3.org/1999/xhtml& ...