├── .gitignore ├── 7z.dll ├── readme.txt └── sevenzip.pas /.gitignore: -------------------------------------------------------------------------------- 1 | *.dcu 2 | /__history 3 | -------------------------------------------------------------------------------- /7z.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wang80919/d7zip/HEAD/7z.dll -------------------------------------------------------------------------------- /readme.txt: -------------------------------------------------------------------------------- 1 | 官网已经找不到了。 2 | 这个地址比较新 3 | https://github.com/zedalaye/d7zip 4 | 在这个基础上 融合了 5 | SevenZip.pas BUG修改版 - 20160613 - 堕落恶魔 - 博客园 6 | https://www.cnblogs.com/hs-kill/p/3876160.html 7 | 然后再加了一些小的修改。 8 | 9 | 最后，提供一个比较全面的 例子。 10 | 【Delphi】从内存读取或解压压缩文件（RAR、ZIP、TAR、GZIP等）（一） - 峋山隐修会 - 博客园 11 | http://www.cnblogs.com/caibirdy1985/archive/2013/05/13/4232949.html 12 | 【Delphi】从内存读取或解压压缩文件（RAR、ZIP、TAR、GZIP等）（二） - 峋山隐修会 - 博客园 13 | http://www.cnblogs.com/caibirdy1985/archive/2013/05/14/4232948.html 14 | 15 | 16 | 17 | 7-zip Delphi API 18 | This API use the 7-zip dll (7z.dll) to read and write all 7-zip supported archive formats. 19 | 20 | - Autor: Henri Gourvest 21 | - Licence: MPL1.1 22 | - Date: 15/04/2009 23 | - Version: 1.2 24 | 25 | Reading archive: 26 | 27 | Extract to path: 28 | 解压到目录： 29 | with CreateInArchive(CLSID_CFormatZip) do 30 | begin 31 | OpenFile('c:\test.zip'); 32 | ExtractTo('c:\test'); 33 | end; 34 | 35 | Get file list: 36 | 获取文件列表: 37 | with CreateInArchive(CLSID_CFormat7z, 'Formats\7z.dll') do 38 | begin 39 | OpenFile('c:\test.7z'); 40 | for i := 0 to NumberOfItems - 1 do 41 | if not ItemIsFolder[i] then 42 | Writeln(ItemPath[i]); 43 | end; 44 | 45 | Extract to stream 46 | 解压到流: 47 | with CreateInArchive(CLSID_CFormat7z) do 48 | begin 49 | OpenFile('c:\test.7z'); 50 | for i := 0 to NumberOfItems - 1 do 51 | if not ItemIsFolder[i] then 52 | ExtractItem(i, stream, false); 53 | end; 54 | 55 | Extract "n" Items 56 | 解压多项目: 57 | function GetStreamCallBack(sender: Pointer; index: Cardinal; 58 | var outStream: ISequentialOutStream): HRESULT; stdcall; 59 | begin 60 | case index of ... 61 | outStream := T7zStream.Create(aStream, soReference); 62 | Result := S_OK; 63 | end; 64 | 65 | procedure TMainForm.ExtractClick(Sender: TObject); 66 | var 67 | i: integer; 68 | items: array[0..2] of Cardinal; 69 | begin 70 | with CreateInArchive(CLSID_CFormat7z) do 71 | begin 72 | OpenFile('c:\test.7z'); 73 | // items must be sorted by index! 74 | items[0] := 0; 75 | items[1] := 1; 76 | items[2] := 2; 77 | ExtractItems(@items, Length(items), false, nil, GetStreamCallBack); 78 | end; 79 | end; 80 | 81 | Open stream 82 | 打开流: 83 | with CreateInArchive(CLSID_CFormatZip) do 84 | begin 85 | OpenStream(T7zStream.Create(TFileStream.Create('c:\test.zip', fmOpenRead), soOwned)); 86 | OpenStream(aStream, soReference); 87 | ... 88 | end; 89 | 90 | Progress bar 91 | 进度条回调: 92 | function ProgressCallback(sender: Pointer; total: boolean; value: int64): HRESULT; stdcall; 93 | begin 94 | if total then 95 | Mainform.ProgressBar.Max := value else 96 | Mainform.ProgressBar.Position := value; 97 | Result := S_OK; 98 | end; 99 | 100 | procedure TMainForm.ExtractClick(Sender: TObject); 101 | begin 102 | with CreateInArchive(CLSID_CFormatZip) do 103 | begin 104 | OpenFile('c:\test.zip'); 105 | SetProgressCallback(nil, ProgressCallback); 106 | ... 107 | end; 108 | end; 109 | 110 | Password 111 | 打开含有密码的文件: 112 | function PasswordCallback(sender: Pointer; var password: WideString): HRESULT; stdcall; 113 | begin 114 | // call a dialog box ... 115 | password := 'password'; 116 | Result := S_OK; 117 | end; 118 | procedure TMainForm.ExtractClick(Sender: TObject); 119 | begin 120 | with CreateInArchive(CLSID_CFormatZip) do 121 | begin 122 | // using callback 123 | SetPasswordCallback(nil, PasswordCallback); 124 | // or setting password directly 125 | SetPassword('password'); 126 | OpenFile('c:\test.zip'); 127 | ... 128 | end; 129 | end; 130 | 131 | Writing archive 132 | 压缩存档: 133 | procedure TMainForm.ExtractAllClick(Sender: TObject); 134 | var 135 | Arch: I7zOutArchive; 136 | begin 137 | Arch := CreateOutArchive(CLSID_CFormat7z); 138 | // add a file 139 | Arch.AddFile('c:\test.bin', 'folder\test.bin'); 140 | // add files using willcards and recursive search 141 | Arch.AddFiles('c:\test', 'folder', '*.pas;*.dfm', true, true); 142 | // add a stream 143 | Arch.AddStream(aStream, soReference, faArchive, CurrentFileTime, CurrentFileTime, 'folder\test.bin', false, false); 144 | // compression level 145 | SetCompressionLevel(Arch, 5); 146 | // compression method if <> LZMA 147 | SevenZipSetCompressionMethod(Arch, m7BZip2); 148 | // add a progress bar ... 149 | Arch.SetProgressCallback(...); 150 | // set a password if necessary 151 | Arch.SetPassword('password'); 152 | // Save to file 153 | Arch.SaveToFile('c:\test.zip'); 154 | // or a stream 155 | Arch.SaveToStream(aStream); 156 | end; 157 | -------------------------------------------------------------------------------- /sevenzip.pas: -------------------------------------------------------------------------------- 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 *) 13 | (* V1.2 *) 14 | (********************************************************************************) 15 | 16 | //V1.1.1(aka 1.2.1) 17 | 18 | (* 19 | 2017-06-08 刘志林 修改 20 | 21 | BUG修改: 22 | 1.对于文件名中带有空格的文件, 无法压缩, 原因是1743行, 压缩调用的是TStringList.Delimiter 来拆分文件字符串, 而空格是默认分行符, 导致文件名错误 23 | 2.解压缩函数, 如果目标文件已存在并且为只读属性时, 报错, 原因是1383行 创建文件流的时候直接使用了TFileStream.Create(path, fmCreate)导致 24 | 3.解压缩函数, 解决如果是空文件夹不会被创建的问题 25 | 26 | 功能增加: 27 | 1.增加了一个WorkPath变量, 用于指定7z.dll文件的绝对路径 28 | 2.增加了一个解压缩过程中文件释放失败时的回调T7zProgressExceptCallback, 支持忽略/重试/取消 29 | 30 | *) 31 | 32 | 33 | //V1.2.2 34 | //新增对 callback 处理错误。 35 | //fix by flying wang. 36 | 37 | //V1.2.3 38 | //新增解压文件的属性设置。 39 | //add IncludeEmptyDir 40 | //add support Int64 for file size 41 | //fix by flying wang. 42 | 43 | //V1.2.5 44 | //add some IFDEF MSWINDOWS 45 | //add ExtractItemToPath from ekot1 46 | //fix by flying wang. 47 | 48 | //also you can use JclCompression instead of this. 49 | 50 | unit sevenzip; 51 | {$ALIGN ON} 52 | {$MINENUMSIZE 4} 53 | {$WARN SYMBOL_PLATFORM OFF} 54 | 55 | interface 56 | uses 57 | {$IFDEF MSWINDOWS} 58 | Windows, ActiveX, 59 | {$ENDIF MSWINDOWS} 60 | {$IFDEF POSIX} 61 | Posix.Dlfcn, Posix.Fcntl, 62 | {$ENDIF POSIX} 63 | SysUtils, Classes, Contnrs; 64 | 65 | var 66 | //fix by 刘志林 67 | G_7zWorkPath: string; {工作路径，查找dll用} 68 | 69 | const 70 | //fix by flying wang. 71 | kCallBackError = $0FFFFFFF; 72 | kCallbackCANCEL = $0FFFFFFE; 73 | kCallbackIGNORE = $0FFFFFFD; 74 | 75 | 76 | 77 | type 78 | PVarType = ^TVarType; 79 | PCardArray = ^TCardArray; 80 | TCardArray = array[0..MaxInt div SizeOf(Cardinal) - 1] of Cardinal; 81 | 82 | {$IFNDEF UNICODE} 83 | UnicodeString = WideString; 84 | {$ENDIF} 85 | 86 | //****************************************************************************** 87 | // PropID.h 88 | //****************************************************************************** 89 | 90 | const 91 | kpidNoProperty = 0; 92 | kpidMainSubfile = 1; 93 | kpidHandlerItemIndex = 2; 94 | kpidPath = 3; // VT_BSTR 95 | kpidName = 4; // VT_BSTR 96 | kpidExtension = 5; // VT_BSTR 97 | kpidIsDir = 6; // VT_BOOL 98 | kpidSize = 7; // VT_UI8 99 | kpidPackSize = 8; // VT_UI8 100 | kpidAttrib = 9; // VT_UI4 101 | kpidCTime = 10; // VT_FILETIME 102 | kpidATime = 11; // VT_FILETIME 103 | kpidMTime = 12; // VT_FILETIME 104 | kpidSolid = 13; // VT_BOOL 105 | kpidCommented = 14; // VT_BOOL 106 | kpidEncrypted = 15; // VT_BOOL 107 | kpidSplitBefore = 16; // VT_BOOL 108 | kpidSplitAfter = 17; // VT_BOOL 109 | kpidDictionarySize = 18; // VT_UI4 110 | kpidCRC = 19; // VT_UI4 111 | kpidType = 20; // VT_BSTR 112 | kpidIsAnti = 21; // VT_BOOL 113 | kpidMethod = 22; // VT_BSTR 114 | kpidHostOS = 23; // VT_BSTR 115 | kpidFileSystem = 24; // VT_BSTR 116 | kpidUser = 25; // VT_BSTR 117 | kpidGroup = 26; // VT_BSTR 118 | kpidBlock = 27; // VT_UI4 119 | kpidComment = 28; // VT_BSTR 120 | kpidPosition = 29; // VT_UI4 121 | kpidPrefix = 30; // VT_BSTR 122 | kpidNumSubDirs = 31; // VT_UI4 123 | kpidNumSubFiles = 32; // VT_UI4 124 | kpidUnpackVer = 33; // VT_UI1 125 | kpidVolume = 34; // VT_UI4 126 | kpidIsVolume = 35; // VT_BOOL 127 | kpidOffset = 36; // VT_UI8 128 | kpidLinks = 37; // VT_UI4 129 | kpidNumBlocks = 38; // VT_UI4 130 | kpidNumVolumes = 39; // VT_UI4 131 | kpidTimeType = 40; // VT_UI4 132 | kpidBit64 = 41; // VT_BOOL 133 | kpidBigEndian = 42; // VT_BOOL 134 | kpidCpu = 43; // VT_BSTR 135 | kpidPhySize = 44; // VT_UI8 136 | kpidHeadersSize = 45; // VT_UI8 137 | kpidChecksum = 46; // VT_UI4 138 | kpidCharacts = 47; // VT_BSTR 139 | kpidVa = 48; // VT_UI8 140 | kpidId = 49; 141 | kpidShortName = 50; 142 | kpidCreatorApp = 51; 143 | kpidSectorSize = 52; 144 | kpidPosixAttrib = 53; 145 | kpidSymLink = 54; 146 | kpidError = 55; 147 | kpidTotalSize = 56; 148 | kpidFreeSpace = 57; 149 | kpidClusterSize = 58; 150 | kpidVolumeName = 59; 151 | kpidLocalName = 60; 152 | kpidProvider = 61; 153 | kpidNtSecure = 62; 154 | kpidIsAltStream = 63; 155 | kpidIsAux = 64; 156 | kpidIsDeleted = 65; 157 | kpidIsTree = 66; 158 | kpidSha1 = 67; 159 | kpidSha256 = 68; 160 | kpidErrorType = 69; 161 | kpidNumErrors = 70; 162 | kpidErrorFlags = 71; 163 | kpidWarningFlags = 72; 164 | kpidWarning = 73; 165 | kpidNumStreams = 74; 166 | kpidNumAltStreams = 75; 167 | kpidAltStreamsSize = 76; 168 | kpidVirtualSize = 77; 169 | kpidUnpackSize = 78; 170 | kpidTotalPhySize = 79; 171 | kpidVolumeIndex = 80; 172 | kpidSubType = 81; 173 | kpidShortComment = 82; 174 | kpidCodePage = 83; 175 | kpidIsNotArcType = 84; 176 | kpidPhySizeCantBeDetected = 85; 177 | kpidZerosTailIsAllowed = 86; 178 | kpidTailSize = 87; 179 | kpidEmbeddedStubSize = 88; 180 | kpidNtReparse = 89; 181 | kpidHardLink = 90; 182 | kpidINode = 91; 183 | kpidStreamId = 92; 184 | kpidReadOnly = 93; 185 | kpidOutName = 94; 186 | kpidCopyLink = 95; 187 | 188 | // kpidTotalSize = $1100; // VT_UI8 189 | // kpidFreeSpace = kpidTotalSize + 1; // VT_UI8 190 | // kpidClusterSize = kpidFreeSpace + 1; // VT_UI8 191 | // kpidVolumeName = kpidClusterSize + 1; // VT_BSTR 192 | // 193 | // kpidLocalName = $1200; // VT_BSTR 194 | // kpidProvider = kpidLocalName + 1; // VT_BSTR 195 | 196 | kpidUserDefined = $10000; 197 | 198 | //****************************************************************************** 199 | // IProgress.h 200 | //****************************************************************************** 201 | type 202 | IProgress = interface(IUnknown) 203 | ['{23170F69-40C1-278A-0000-000000050000}'] 204 | function SetTotal(total: Int64): HRESULT; stdcall; 205 | function SetCompleted(completeValue: PInt64): HRESULT; stdcall; 206 | end; 207 | 208 | //****************************************************************************** 209 | // IPassword.h 210 | //****************************************************************************** 211 | 212 | ICryptoGetTextPassword = interface(IUnknown) 213 | ['{23170F69-40C1-278A-0000-000500100000}'] 214 | function CryptoGetTextPassword(var password: TBStr): HRESULT; stdcall; 215 | end; 216 | 217 | ICryptoGetTextPassword2 = interface(IUnknown) 218 | ['{23170F69-40C1-278A-0000-000500110000}'] 219 | function CryptoGetTextPassword2(passwordIsDefined: PInteger; var password: TBStr): HRESULT; stdcall; 220 | end; 221 | 222 | //****************************************************************************** 223 | // IStream.h 224 | // "23170F69-40C1-278A-0000-000300xx0000" 225 | //****************************************************************************** 226 | 227 | ISequentialInStream = interface(IUnknown) 228 | ['{23170F69-40C1-278A-0000-000300010000}'] 229 | function Read(data: Pointer; size: Cardinal; processedSize: PCardinal): HRESULT; stdcall; 230 | (* 231 | The requirement for caller: (processedSize != NULL). 232 | The callee can allow (processedSize == NULL) for compatibility reasons. 233 | 234 | if (size == 0), this function returns S_OK and (*processedSize) is set to 0. 235 | 236 | if (size != 0) 237 | { 238 | Partial read is allowed: (*processedSize <= avail_size && *processedSize <= size), 239 | where (avail_size) is the size of remaining bytes in stream. 240 | If (avail_size != 0), this function must read at least 1 byte: (*processedSize > 0). 241 | You must call Read() in loop, if you need to read exact amount of data. 242 | } 243 | 244 | If seek pointer before Read() call was changed to position past the end of stream: 245 | if (seek_pointer >= stream_size), this function returns S_OK and (*processedSize) is set to 0. 246 | 247 | ERROR CASES: 248 | If the function returns error code, then (*processedSize) is size of 249 | data written to (data) buffer (it can be data before error or data with errors). 250 | The recommended way for callee to work with reading errors: 251 | 1) write part of data before error to (data) buffer and return S_OK. 252 | 2) return error code for further calls of Read(). 253 | *) 254 | end; 255 | 256 | ISequentialOutStream = interface(IUnknown) 257 | ['{23170F69-40C1-278A-0000-000300020000}'] 258 | function Write(data: Pointer; size: Cardinal; processedSize: PCardinal): HRESULT; stdcall; 259 | (* 260 | The requirement for caller: (processedSize != NULL). 261 | The callee can allow (processedSize == NULL) for compatibility reasons. 262 | 263 | if (size != 0) 264 | { 265 | Partial write is allowed: (*processedSize <= size), 266 | but this function must write at least 1 byte: (*processedSize > 0). 267 | You must call Write() in loop, if you need to write exact amount of data. 268 | } 269 | 270 | ERROR CASES: 271 | If the function returns error code, then (*processedSize) is size of 272 | data written from (data) buffer. 273 | *) 274 | end; 275 | 276 | IInStream = interface(ISequentialInStream) 277 | ['{23170F69-40C1-278A-0000-000300030000}'] 278 | function Seek(offset: Int64; seekOrigin: Cardinal; newPosition: PInt64): HRESULT; stdcall; 279 | end; 280 | 281 | IOutStream = interface(ISequentialOutStream) 282 | ['{23170F69-40C1-278A-0000-000300040000}'] 283 | function Seek(offset: Int64; seekOrigin: Cardinal; newPosition: PInt64): HRESULT; stdcall; 284 | function SetSize(newSize: Int64): HRESULT; stdcall; 285 | end; 286 | 287 | IStreamGetSize = interface(IUnknown) 288 | ['{23170F69-40C1-278A-0000-000300060000}'] 289 | function GetSize(size: PInt64): HRESULT; stdcall; 290 | end; 291 | 292 | IOutStreamFinish = interface(IUnknown) 293 | ['{23170F69-40C1-278A-0000-000300070000}'] 294 | function Flush: HRESULT; stdcall; 295 | end; 296 | 297 | //****************************************************************************** 298 | // IArchive.h 299 | //****************************************************************************** 300 | 301 | // MIDL_INTERFACE("23170F69-40C1-278A-0000-000600xx0000") 302 | //#define ARCHIVE_INTERFACE_SUB(i, base, x) \ 303 | //DEFINE_GUID(IID_ ## i, \ 304 | //0x23170F69, 0x40C1, 0x278A, 0x00, 0x00, 0x00, 0x06, 0x00, x, 0x00, 0x00); \ 305 | //struct i: public base 306 | 307 | //#define ARCHIVE_INTERFACE(i, x) ARCHIVE_INTERFACE_SUB(i, IUnknown, x) 308 | 309 | type 310 | // NFileTimeType 311 | NFileTimeType = ( 312 | kWindows = 0, 313 | kUnix, 314 | kDOS 315 | ); 316 | 317 | // NArcInfoFlags 318 | NArcInfoFlags = ( 319 | aifKeepName = 1 shl 0, // keep name of file in archive name 320 | aifAltStreams = 1 shl 1, // the handler supports alt streams 321 | aifNtSecure = 1 shl 2, // the handler supports NT security 322 | aifFindSignature = 1 shl 3, // the handler can find start of archive 323 | aifMultiSignature = 1 shl 4, // there are several signatures 324 | aifUseGlobalOffset = 1 shl 5, // the seek position of stream must be set as global offset 325 | aifStartOpen = 1 shl 6, // call handler for each start position 326 | aifPureStartOpen = 1 shl 7, // call handler only for start of file 327 | aifBackwardOpen = 1 shl 8, // archive can be open backward 328 | aifPreArc = 1 shl 9, // such archive can be stored before real archive (like SFX stub) 329 | aifSymLinks = 1 shl 10, // the handler supports symbolic links 330 | aifHardLinks = 1 shl 11 // the handler supports hard links 331 | ); 332 | 333 | // NArchive::NHandlerPropID 334 | NHandlerPropID = ( 335 | kName = 0, // VT_BSTR 336 | kClassID, // binary GUID in VT_BSTR 337 | kExtension, // VT_BSTR 338 | kAddExtension, // VT_BSTR 339 | kUpdate, // VT_BOOL 340 | kKeepName, // VT_BOOL 341 | kSignature, // binary in VT_BSTR 342 | kMultiSignature, // binary in VT_BSTR 343 | kSignatureOffset, // VT_UI4 344 | kAltStreams, // VT_BOOL 345 | kNtSecure, // VT_BOOL 346 | kFlags // VT_UI4 347 | // kVersion // VT_UI4 ((VER_MAJOR << 8) | VER_MINOR) 348 | ); 349 | 350 | // NArchive::NExtract::NAskMode 351 | NAskMode = ( 352 | kExtract = 0, 353 | kTest, 354 | kSkip 355 | ); 356 | 357 | // NArchive::NExtract::NOperationResult 358 | NExtOperationResult = ( 359 | kOK = 0, 360 | kUnSupportedMethod, 361 | kDataError, 362 | kCRCError, 363 | kUnavailable, 364 | kUnexpectedEnd, 365 | kDataAfterEnd, 366 | kIsNotArc, 367 | kHeadersError, 368 | kWrongPassword 369 | ); 370 | 371 | // NArchive::NEventIndexType 372 | NEventIndexType = ( 373 | kNoIndex = 0, 374 | kInArcIndex, 375 | kBlockIndex, 376 | kOutArcIndex 377 | ); 378 | 379 | // NArchive::NUpdate::NOperationResult 380 | NUpdOperationResult = ( 381 | kOK_ = 0, 382 | kError 383 | ); 384 | 385 | IArchiveOpenCallback = interface 386 | ['{23170F69-40C1-278A-0000-000600100000}'] 387 | function SetTotal(files, bytes: PInt64): HRESULT; stdcall; 388 | function SetCompleted(files, bytes: PInt64): HRESULT; stdcall; 389 | (* 390 | IArchiveExtractCallback:: 391 | 392 | 7-Zip doesn't call IArchiveExtractCallback functions 393 | GetStream() 394 | PrepareOperation() 395 | SetOperationResult() 396 | from different threads simultaneously. 397 | But 7-Zip can call functions for IProgress or ICompressProgressInfo functions 398 | from another threads simultaneously with calls for IArchiveExtractCallback interface. 399 | 400 | IArchiveExtractCallback::GetStream() 401 | UInt32 index - index of item in Archive 402 | Int32 askExtractMode (Extract::NAskMode) 403 | if (askMode != NExtract::NAskMode::kExtract) 404 | { 405 | then the callee can not real stream: (*inStream == NULL) 406 | } 407 | 408 | Out: 409 | (*inStream == NULL) - for directories 410 | (*inStream == NULL) - if link (hard link or symbolic link) was created 411 | if (*inStream == NULL && askMode == NExtract::NAskMode::kExtract) 412 | { 413 | then the caller must skip extracting of that file. 414 | } 415 | 416 | returns: 417 | S_OK : OK 418 | S_FALSE : data error (for decoders) 419 | 420 | if (IProgress::SetTotal() was called) 421 | { 422 | IProgress::SetCompleted(completeValue) uses 423 | packSize - for some stream formats (xz, gz, bz2, lzma, z, ppmd). 424 | unpackSize - for another formats. 425 | } 426 | else 427 | { 428 | IProgress::SetCompleted(completeValue) uses packSize. 429 | } 430 | 431 | SetOperationResult() 432 | 7-Zip calls SetOperationResult at the end of extracting, 433 | so the callee can close the file, set attributes, timestamps and security information. 434 | 435 | Int32 opRes (NExtract::NOperationResult) 436 | *) 437 | end; 438 | 439 | IArchiveExtractCallback = interface(IProgress) 440 | ['{23170F69-40C1-278A-0000-000600200000}'] 441 | function GetStream(index: Cardinal; var outStream: ISequentialOutStream; 442 | askExtractMode: NAskMode): HRESULT; stdcall; 443 | // GetStream OUT: S_OK - OK, S_FALSE - skeep this file 444 | function PrepareOperation(askExtractMode: NAskMode): HRESULT; stdcall; 445 | function SetOperationResult(resultEOperationResult: NExtOperationResult): HRESULT; stdcall; 446 | (* 447 | IArchiveExtractCallbackMessage can be requested from IArchiveExtractCallback object 448 | by Extract() or UpdateItems() functions to report about extracting errors 449 | ReportExtractResult() 450 | UInt32 indexType (NEventIndexType) 451 | UInt32 index 452 | Int32 opRes (NExtract::NOperationResult) 453 | *) 454 | end; 455 | 456 | IArchiveExtractCallbackMessage = interface 457 | ['{23170F69-40C1-278A-0000-000600210000}'] 458 | function ReportExtractResult(indexType: NEventIndexType; index: Cardinal; opRes: Integer): HRESULT; stdcall; 459 | end; 460 | 461 | IArchiveOpenVolumeCallback = interface 462 | ['{23170F69-40C1-278A-0000-000600300000}'] 463 | function GetProperty(propID: PROPID; var value: OleVariant): HRESULT; stdcall; 464 | function GetStream(const name: PWideChar; var inStream: IInStream): HRESULT; stdcall; 465 | end; 466 | 467 | IInArchiveGetStream = interface 468 | ['{23170F69-40C1-278A-0000-000600400000}'] 469 | function GetStream(index: Cardinal; var stream: ISequentialInStream ): HRESULT; stdcall; 470 | end; 471 | 472 | IArchiveOpenSetSubArchiveName = interface 473 | ['{23170F69-40C1-278A-0000-000600500000}'] 474 | function SetSubArchiveName(name: PWideChar): HRESULT; stdcall; 475 | end; 476 | 477 | IInArchive = interface 478 | ['{23170F69-40C1-278A-0000-000600600000}'] 479 | function Open(stream: IInStream; const maxCheckStartPosition: PInt64; 480 | openArchiveCallback: IArchiveOpenCallback): HRESULT; stdcall; 481 | (* 482 | IInArchive::Open 483 | stream 484 | if (kUseGlobalOffset), stream current position can be non 0. 485 | if (!kUseGlobalOffset), stream current position is 0. 486 | if (maxCheckStartPosition == NULL), the handler can try to search archive start in stream 487 | if (*maxCheckStartPosition == 0), the handler must check only current position as archive start 488 | 489 | IInArchive::Extract: 490 | indices must be sorted 491 | numItems = (UInt32)(Int32)-1 = 0xFFFFFFFF means "all files" 492 | testMode != 0 means "test files without writing to outStream" 493 | 494 | IInArchive::GetArchiveProperty: 495 | kpidOffset - start offset of archive. 496 | VT_EMPTY : means offset = 0. 497 | VT_UI4, VT_UI8, VT_I8 : result offset; negative values is allowed 498 | kpidPhySize - size of archive. VT_EMPTY means unknown size. 499 | kpidPhySize is allowed to be larger than file size. In that case it must show 500 | supposed size. 501 | 502 | kpidIsDeleted: 503 | kpidIsAltStream: 504 | kpidIsAux: 505 | kpidINode: 506 | must return VARIANT_TRUE (VT_BOOL), if archive can support that property in GetProperty. 507 | 508 | 509 | Notes: 510 | Don't call IInArchive functions for same IInArchive object from different threads simultaneously. 511 | Some IInArchive handlers will work incorrectly in that case. 512 | *) 513 | 514 | function Close: HRESULT; stdcall; 515 | function GetNumberOfItems(var numItems: CArdinal): HRESULT; stdcall; 516 | function GetProperty(index: Cardinal; propID: PROPID; var value: OleVariant): HRESULT; stdcall; 517 | function Extract(indices: PCardArray; numItems: Cardinal; 518 | testMode: Integer; extractCallback: IArchiveExtractCallback): HRESULT; stdcall; 519 | // indices must be sorted 520 | // numItems = 0xFFFFFFFF means all files 521 | // testMode != 0 means "test files operation" 522 | 523 | function GetArchiveProperty(propID: PROPID; var value: OleVariant): HRESULT; stdcall; 524 | 525 | function GetNumberOfProperties(numProperties: PCardinal): HRESULT; stdcall; 526 | function GetPropertyInfo(index: Cardinal; 527 | name: PBSTR; propID: PPropID; varType: PVarType): HRESULT; stdcall; 528 | 529 | function GetNumberOfArchiveProperties(var numProperties: Cardinal): HRESULT; stdcall; 530 | function GetArchivePropertyInfo(index: Cardinal; 531 | name: PBSTR; propID: PPropID; varType: PVARTYPE): HRESULT; stdcall; 532 | end; 533 | 534 | IArchiveOpenSeq = interface 535 | ['{23170F69-40C1-278A-0000-000600610000}'] 536 | function OpenSeq(var stream: ISequentialInStream): HRESULT; stdcall; 537 | end; 538 | 539 | // NParentType:: 540 | NParentType = ( 541 | kDir = 0, 542 | kAltStream 543 | ); 544 | 545 | // NPropDataType:: 546 | NPropDataType = ( 547 | kMask_ZeroEnd = $10, // 1 shl 4, 548 | // kMask_BigEndian = 1 shl 5, 549 | kMask_Utf = $40, // 1 shl 6, 550 | kMask_Utf8 = $40, // kMask_Utf or 0, 551 | kMask_Utf16 = $41, // kMask_Utf or 1, 552 | // kMask_Utf32 = $42, // kMask_Utf or 2, 553 | 554 | kNotDefined = 0, 555 | kRaw = 1, 556 | 557 | kUtf8z = $50, // kMask_Utf8 or kMask_ZeroEnd, 558 | kUtf16z = $51 // kMask_Utf16 or kMask_ZeroEnd 559 | ); 560 | 561 | IArchiveGetRawProps = interface 562 | ['{23170F69-40C1-278A-0000-000600700000}'] 563 | function GetParent(index: Cardinal; var parent: Cardinal; var parentType: Cardinal): HRESULT; stdcall; 564 | function GetRawProp(index: Cardinal; propID: PROPID; var data: Pointer; var dataSize: Cardinal; var propType: Cardinal): HRESULT; stdcall; 565 | function GetNumRawProps(var numProps: Cardinal): HRESULT; stdcall; 566 | function GetRawPropInfo(index: Cardinal; name: PBSTR; var propID: PROPID): HRESULT; stdcall; 567 | end; 568 | 569 | IArchiveGetRootProps = interface 570 | ['{23170F69-40C1-278A-0000-000600710000}'] 571 | function GetRootProp(propID: PROPID; var value: PROPVARIANT): HRESULT; stdcall; 572 | function GetRootRawProp(propID: PROPID; var data: Pointer; var dataSize: Cardinal; var propType: Cardinal): HRESULT; stdcall; 573 | end; 574 | 575 | IArchiveUpdateCallback = interface(IProgress) 576 | ['{23170F69-40C1-278A-0000-000600800000}'] 577 | function GetUpdateItemInfo(index: Cardinal; 578 | newData: PInteger; // 1 - new data, 0 - old data 579 | newProperties: PInteger; // 1 - new properties, 0 - old properties 580 | indexInArchive: PCardinal // -1 if there is no in archive, or if doesn't matter 581 | ): HRESULT; stdcall; 582 | function GetProperty(index: Cardinal; propID: PROPID; var value: OleVariant): HRESULT; stdcall; 583 | function GetStream(index: Cardinal; var inStream: ISequentialInStream): HRESULT; stdcall; 584 | function SetOperationResult(operationResult: Integer): HRESULT; stdcall; 585 | end; 586 | 587 | IArchiveUpdateCallback2 = interface(IArchiveUpdateCallback) 588 | ['{23170F69-40C1-278A-0000-000600820000}'] 589 | function GetVolumeSize(index: Cardinal; size: PInt64): HRESULT; stdcall; 590 | function GetVolumeStream(index: Cardinal; var volumeStream: ISequentialOutStream): HRESULT; stdcall; 591 | end; 592 | 593 | IOutArchive = interface 594 | ['{23170F69-40C1-278A-0000-000600A00000}'] 595 | function UpdateItems(outStream: ISequentialOutStream; numItems: Cardinal; 596 | updateCallback: IArchiveUpdateCallback): HRESULT; stdcall; 597 | function GetFileTimeType(type_: PCardinal): HRESULT; stdcall; 598 | end; 599 | 600 | ISetProperties = interface 601 | ['{23170F69-40C1-278A-0000-000600030000}'] 602 | function SetProperties(names: PPWideChar; values: PPROPVARIANT; numProperties: Integer): HRESULT; stdcall; 603 | end; 604 | 605 | //****************************************************************************** 606 | // ICoder.h 607 | // "23170F69-40C1-278A-0000-000400xx0000" 608 | //****************************************************************************** 609 | 610 | ICompressProgressInfo = interface 611 | ['{23170F69-40C1-278A-0000-000400040000}'] 612 | function SetRatioInfo(inSize, outSize: PInt64): HRESULT; stdcall; 613 | end; 614 | 615 | ICompressCoder = interface 616 | ['{23170F69-40C1-278A-0000-000400050000}'] 617 | function Code(inStream, outStream: ISequentialInStream; 618 | inSize, outSize: PInt64; 619 | progress: ICompressProgressInfo): HRESULT; stdcall; 620 | end; 621 | 622 | ICompressCoder2 = interface 623 | ['{23170F69-40C1-278A-0000-000400180000}'] 624 | function Code(var inStreams: ISequentialInStream; 625 | var inSizes: PInt64; 626 | numInStreams: Cardinal; 627 | var outStreams: ISequentialOutStream; 628 | var outSizes: PInt64; 629 | numOutStreams: Cardinal; 630 | progress: ICompressProgressInfo): HRESULT; stdcall; 631 | end; 632 | 633 | //NCoderPropID:: 634 | NCoderPropID = ( 635 | kDefaultProp = 0, 636 | kDictionarySize, 637 | kUsedMemorySize, 638 | kOrder, 639 | kBlockSize, 640 | kPosStateBits, 641 | kLitContextBits, 642 | kLitPosBits, 643 | kNumFastBytes, 644 | kMatchFinder, 645 | kMatchFinderCycles, 646 | kNumPasses, 647 | kAlgorithm, 648 | kNumThreads, 649 | kEndMarker, 650 | kLevel, 651 | kReduceSize // estimated size of data that will be compressed. Encoder can use this value to reduce dictionary size. 652 | ); 653 | 654 | type 655 | ICompressSetCoderProperties = interface 656 | ['{23170F69-40C1-278A-0000-000400200000}'] 657 | function SetCoderProperties(propIDs: PPropID; 658 | properties: PROPVARIANT; numProperties: Cardinal): HRESULT; stdcall; 659 | end; 660 | 661 | (* 662 | CODER_INTERFACE(ICompressSetCoderProperties, 0x21) 663 | { 664 | STDMETHOD(SetDecoderProperties)(ISequentialInStream *inStream) PURE; 665 | }; 666 | *) 667 | 668 | ICompressSetDecoderProperties2 = interface 669 | ['{23170F69-40C1-278A-0000-000400220000}'] 670 | function SetDecoderProperties2(data: PByte; size: Cardinal): HRESULT; stdcall; 671 | end; 672 | 673 | ICompressWriteCoderProperties = interface 674 | ['{23170F69-40C1-278A-0000-000400230000}'] 675 | function WriteCoderProperties(outStreams: ISequentialOutStream): HRESULT; stdcall; 676 | end; 677 | 678 | ICompressGetInStreamProcessedSize = interface 679 | ['{23170F69-40C1-278A-0000-000400240000}'] 680 | function GetInStreamProcessedSize(value: PInt64): HRESULT; stdcall; 681 | end; 682 | 683 | ICompressSetCoderMt = interface 684 | ['{23170F69-40C1-278A-0000-000400250000}'] 685 | function SetNumberOfThreads(numThreads: Cardinal): HRESULT; stdcall; 686 | end; 687 | 688 | ICompressGetSubStreamSize = interface 689 | ['{23170F69-40C1-278A-0000-000400300000}'] 690 | function GetSubStreamSize(subStream: Int64; value: PInt64): HRESULT; stdcall; 691 | end; 692 | 693 | ICompressSetInStream = interface 694 | ['{23170F69-40C1-278A-0000-000400310000}'] 695 | function SetInStream(inStream: ISequentialInStream): HRESULT; stdcall; 696 | function ReleaseInStream: HRESULT; stdcall; 697 | end; 698 | 699 | ICompressSetOutStream = interface 700 | ['{23170F69-40C1-278A-0000-000400320000}'] 701 | function SetOutStream(outStream: ISequentialOutStream): HRESULT; stdcall; 702 | function ReleaseOutStream: HRESULT; stdcall; 703 | end; 704 | 705 | ICompressSetInStreamSize = interface 706 | ['{23170F69-40C1-278A-0000-000400330000}'] 707 | function SetInStreamSize(inSize: PInt64): HRESULT; stdcall; 708 | end; 709 | 710 | ICompressSetOutStreamSize = interface 711 | ['{23170F69-40C1-278A-0000-000400340000}'] 712 | function SetOutStreamSize(outSize: PInt64): HRESULT; stdcall; 713 | end; 714 | 715 | ICompressFilter = interface 716 | ['{23170F69-40C1-278A-0000-000400400000}'] 717 | function Init: HRESULT; stdcall; 718 | function Filter(data: PByte; size: Cardinal): Cardinal; stdcall; 719 | // Filter return outSize (Cardinal) 720 | // if (outSize <= size): Filter have converted outSize bytes 721 | // if (outSize > size): Filter have not converted anything. 722 | // and it needs at least outSize bytes to convert one block 723 | // (it's for crypto block algorithms). 724 | end; 725 | 726 | ICryptoProperties = interface 727 | ['{23170F69-40C1-278A-0000-000400800000}'] 728 | function SetKey(Data: PByte; size: Cardinal): HRESULT; stdcall; 729 | function SetInitVector(data: PByte; size: Cardinal): HRESULT; stdcall; 730 | end; 731 | 732 | ICryptoSetPassword = interface 733 | ['{23170F69-40C1-278A-0000-000400900000}'] 734 | function CryptoSetPassword(data: PByte; size: Cardinal): HRESULT; stdcall; 735 | end; 736 | 737 | ICryptoSetCRC = interface 738 | ['{23170F69-40C1-278A-0000-000400A00000}'] 739 | function CryptoSetCRC(crc: Cardinal): HRESULT; stdcall; 740 | end; 741 | 742 | ////////////////////// 743 | // It's for DLL file 744 | //NMethodPropID:: 745 | NMethodPropID = ( 746 | kID, 747 | kMethodName, // kName 748 | kDecoder, 749 | kEncoder, 750 | kPackStreams, 751 | kUnpackStreams, 752 | kDescription, 753 | kDecoderIsAssigned, 754 | kEncoderIsAssigned, 755 | kDigestSize 756 | ); 757 | 758 | //****************************************************************************** 759 | // CLASSES 760 | //****************************************************************************** 761 | 762 | T7zPasswordCallback = function(sender: Pointer; var password: UnicodeString): HRESULT; stdcall; 763 | T7zGetStreamCallBack = function(sender: Pointer; index: Cardinal; 764 | var outStream: ISequentialOutStream): HRESULT; stdcall; 765 | T7zProgressCallback = function(sender: Pointer; total: boolean; value: int64): HRESULT; stdcall; 766 | //fix by 刘志林 767 | NECallBack = ( 768 | EC_RETRY = 0, 769 | EC_IGNORE, 770 | EC_CANCEL 771 | ); 772 | T7zProgressExceptCallback = function(sender: Pointer; AFile: string): NECallBack; stdcall; 773 | 774 | I7zInArchive = interface 775 | ['{022CF785-3ECE-46EF-9755-291FA84CC6C9}'] 776 | procedure OpenFile(const filename: string); stdcall; 777 | procedure OpenStream(stream: IInStream); stdcall; 778 | procedure Close; stdcall; 779 | function GetNumberOfItems: Cardinal; stdcall; 780 | function GetItemPath(const index: integer): UnicodeString; stdcall; 781 | function GetItemName(const index: integer): UnicodeString; stdcall; 782 | function GetItemSize(const index: integer): Int64; stdcall; 783 | //fix by flying wang. 784 | function GetItemCompressedSize(const index: integer): Int64; stdcall; 785 | {$IFDEF MSWINDOWS} 786 | function GetItemFileTime(const index: integer): TFileTime; stdcall; 787 | {$ENDIF MSWINDOWS} 788 | function GetItemDataTime(const index: integer): TDateTime; stdcall; 789 | function GetItemIsFolder(const index: integer): boolean; stdcall; 790 | function GetInArchive: IInArchive; 791 | procedure ExtractItem(const item: Cardinal; Stream: TStream; test: longbool); stdcall; 792 | //fix or add by ekot1 793 | procedure ExtractItemToPath(const item: Cardinal; const path: string; test: longbool); stdcall; 794 | procedure ExtractItems(items: PCardArray; count: cardinal; test: longbool; 795 | sender: pointer; callback: T7zGetStreamCallBack); stdcall; 796 | procedure ExtractAll(test: longbool; sender: pointer; callback: T7zGetStreamCallBack); stdcall; 797 | procedure ExtractTo(const path: string); stdcall; 798 | procedure SetPasswordCallback(sender: Pointer; callback: T7zPasswordCallback); stdcall; 799 | procedure SetPassword(const password: UnicodeString); stdcall; 800 | procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall; 801 | //fix by 刘志林 802 | procedure SetProgressExceptCallback(sender: Pointer; callback: T7zProgressExceptCallback); stdcall; 803 | procedure SetClassId(const classid: TGUID); 804 | function GetClassId: TGUID; 805 | property ClassId: TGUID read GetClassId write SetClassId; 806 | property NumberOfItems: Cardinal read GetNumberOfItems; 807 | property ItemPath[const index: integer]: UnicodeString read GetItemPath; 808 | property ItemName[const index: integer]: UnicodeString read GetItemName; 809 | property ItemSize[const index: integer]: Int64 read GetItemSize; 810 | //fix by flying wang. 811 | property ItemCompressedSize[const index: integer]: Int64 read GetItemCompressedSize; 812 | {$IFDEF MSWINDOWS} 813 | property ItemFileTime[const index: integer]: TFileTime read GetItemFileTime; 814 | {$ENDIF MSWINDOWS} 815 | property ItemDataTime[const index: integer]: TDateTime read GetItemDataTime; 816 | property ItemIsFolder[const index: integer]: boolean read GetItemIsFolder; 817 | property InArchive: IInArchive read GetInArchive; 818 | end; 819 | 820 | I7zOutArchive = interface 821 | ['{BAA9D5DC-9FF4-4382-9BFD-EC9065BD0125}'] 822 | procedure AddStream(Stream: TStream; Ownership: TStreamOwnership; Attributes: Cardinal; 823 | CreationTime, LastWriteTime: TFileTime; const Path: UnicodeString; 824 | IsFolder, IsAnti: boolean); stdcall; 825 | procedure AddFile(const Filename: TFileName; const Path: UnicodeString); stdcall; 826 | procedure AddFiles(const Dir, Path, Wildcard: string; recurse, IncludeEmptyDir: boolean); stdcall; 827 | procedure SaveToFile(const FileName: TFileName); stdcall; 828 | procedure SaveToStream(stream: TStream); stdcall; 829 | procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall; 830 | procedure ClearBatch; stdcall; 831 | procedure SetPassword(const password: UnicodeString); stdcall; 832 | procedure SetPropertie(name: UnicodeString; value: OleVariant); stdcall; 833 | procedure SetClassId(const classid: TGUID); 834 | function GetClassId: TGUID; 835 | property ClassId: TGUID read GetClassId write SetClassId; 836 | end; 837 | 838 | I7zCodec = interface 839 | ['{AB48F772-F6B1-411E-907F-1567DB0E93B3}'] 840 | 841 | end; 842 | 843 | 844 | T7zStream = class(TInterfacedObject, IInStream, IStreamGetSize, 845 | ISequentialOutStream, ISequentialInStream, IOutStream, IOutStreamFinish) 846 | private 847 | FStream: TStream; 848 | FOwnership: TStreamOwnership; 849 | protected 850 | function Read(data: Pointer; size: Cardinal; processedSize: PCardinal): HRESULT; stdcall; 851 | function Seek(offset: Int64; seekOrigin: Cardinal; newPosition: Pint64): HRESULT; stdcall; 852 | function GetSize(size: PInt64): HRESULT; stdcall; 853 | function SetSize(newSize: Int64): HRESULT; stdcall; 854 | function Write(data: Pointer; size: Cardinal; processedSize: PCardinal): HRESULT; stdcall; 855 | function Flush: HRESULT; stdcall; 856 | public 857 | constructor Create(Stream: TStream; Ownership: TStreamOwnership = soReference); 858 | destructor Destroy; override; 859 | end; 860 | 861 | // I7zOutArchive property setters 862 | type 863 | TZipCompressionMethod = (mzCopy, mzDeflate, mzDeflate64, mzBZip2, mzLZMA, mzPPMD); 864 | TZipEncryptionMethod = (emAES128, emAES192, emAES256, emZIPCRYPTO); 865 | T7zCompressionMethod = (m7Copy, m7LZMA, m7BZip2, m7PPMd, m7Deflate, m7Deflate64); 866 | // ZIP 7z GZIP BZ2 867 | procedure SetCompressionLevel(Arch: I7zOutArchive; level: Cardinal); // X X X X 868 | procedure SetMultiThreading(Arch: I7zOutArchive; ThreadCount: Cardinal); // X X X 869 | 870 | procedure SetCompressionMethod(Arch: I7zOutArchive; method: TZipCompressionMethod); // X 871 | procedure SetEncryptionMethod(Arch: I7zOutArchive; method: TZipEncryptionMethod); // X 872 | procedure SetDictionnarySize(Arch: I7zOutArchive; size: Cardinal); // < 32 // X X 873 | procedure SetMemorySize(Arch: I7zOutArchive; size: Cardinal); // X 874 | procedure SetDeflateNumPasses(Arch: I7zOutArchive; pass: Cardinal); // X X X 875 | procedure SetNumFastBytes(Arch: I7zOutArchive; fb: Cardinal); // X X 876 | procedure SetNumMatchFinderCycles(Arch: I7zOutArchive; mc: Cardinal); // X X 877 | 878 | 879 | procedure SevenZipSetCompressionMethod(Arch: I7zOutArchive; method: T7zCompressionMethod); // X 880 | procedure SevenZipSetBindInfo(Arch: I7zOutArchive; const bind: UnicodeString); // X 881 | procedure SevenZipSetSolidSettings(Arch: I7zOutArchive; solid: boolean); // X 882 | procedure SevenZipRemoveSfxBlock(Arch: I7zOutArchive; remove: boolean); // X 883 | procedure SevenZipAutoFilter(Arch: I7zOutArchive; auto: boolean); // X 884 | procedure SevenZipCompressHeaders(Arch: I7zOutArchive; compress: boolean); // X 885 | procedure SevenZipCompressHeadersFull(Arch: I7zOutArchive; compress: boolean); // X 886 | procedure SevenZipEncryptHeaders(Arch: I7zOutArchive; Encrypt: boolean); // X 887 | procedure SevenZipVolumeMode(Arch: I7zOutArchive; Mode: boolean); // X 888 | 889 | {$IFDEF MSWINDOWS} 890 | // filetime util functions 891 | function DateTimeToFileTime(dt: TDateTime): TFileTime; 892 | function FileTimeToDateTime(ft: TFileTime): TDateTime; 893 | function CurrentFileTime: TFileTime; 894 | {$ENDIF MSWINDOWS} 895 | 896 | // constructors 897 | const 898 | {$IFDEF MSWINDOWS} 899 | C_7zDllName = '7z.dll'; 900 | {$ENDIF MSWINDOWS} 901 | {$IFDEF POSIX} 902 | C_7zDllName = 'lib7z.so'; 903 | {$ENDIF POSIX} 904 | 905 | function CreateInArchive(const classid: TGUID; const lib: string = C_7zDllName): I7zInArchive; 906 | function CreateOutArchive(const classid: TGUID; const lib: string = C_7zDllName): I7zOutArchive; 907 | 908 | const 909 | CLSID_CFormatZip : TGUID = '{23170F69-40C1-278A-1000-000110010000}'; // [OUT] zip jar xpi 910 | CLSID_CFormatBZ2 : TGUID = '{23170F69-40C1-278A-1000-000110020000}'; // [OUT] bz2 bzip2 tbz2 tbz 911 | CLSID_CFormatRar : TGUID = '{23170F69-40C1-278A-1000-000110030000}'; // [IN ] rar r00 912 | CLSID_CFormatArj : TGUID = '{23170F69-40C1-278A-1000-000110040000}'; // [IN ] arj 913 | CLSID_CFormatZ : TGUID = '{23170F69-40C1-278A-1000-000110050000}'; // [IN ] z taz 914 | CLSID_CFormatLzh : TGUID = '{23170F69-40C1-278A-1000-000110060000}'; // [IN ] lzh lha 915 | CLSID_CFormat7z : TGUID = '{23170F69-40C1-278A-1000-000110070000}'; // [OUT] 7z 916 | CLSID_CFormatCab : TGUID = '{23170F69-40C1-278A-1000-000110080000}'; // [IN ] cab 917 | CLSID_CFormatNsis : TGUID = '{23170F69-40C1-278A-1000-000110090000}'; // [IN ] nsis 918 | CLSID_CFormatLzma : TGUID = '{23170F69-40C1-278A-1000-0001100A0000}'; // [IN ] lzma 919 | CLSID_CFormatLzma86 : TGUID = '{23170F69-40C1-278A-1000-0001100B0000}'; // [IN ] lzma 86 920 | CLSID_CFormatXz : TGUID = '{23170F69-40C1-278A-1000-0001100C0000}'; // [OUT] xz 921 | CLSID_CFormatPpmd : TGUID = '{23170F69-40C1-278A-1000-0001100D0000}'; // [IN ] ppmd 922 | 923 | CLSID_CFormatExt : TGUID = '{23170F69-40C1-278A-1000-000110C70000}'; // [IN ] ext 924 | CLSID_CFormatVMDK : TGUID = '{23170F69-40C1-278A-1000-000110C80000}'; // [IN ] vmdk 925 | CLSID_CFormatVDI : TGUID = '{23170F69-40C1-278A-1000-000110C90000}'; // [IN ] vdi 926 | CLSID_CFormatQcow : TGUID = '{23170F69-40C1-278A-1000-000110CA0000}'; // [IN ] qcow 927 | CLSID_CFormatGPT : TGUID = '{23170F69-40C1-278A-1000-000110CB0000}'; // [IN ] GPT 928 | CLSID_CFormatRar5 : TGUID = '{23170F69-40C1-278A-1000-000110CC0000}'; // [IN ] Rar5 929 | CLSID_CFormatIHex : TGUID = '{23170F69-40C1-278A-1000-000110CD0000}'; // [IN ] IHex 930 | CLSID_CFormatHxs : TGUID = '{23170F69-40C1-278A-1000-000110CE0000}'; // [IN ] Hxs 931 | CLSID_CFormatTE : TGUID = '{23170F69-40C1-278A-1000-000110CF0000}'; // [IN ] TE 932 | CLSID_CFormatUEFIc : TGUID = '{23170F69-40C1-278A-1000-000110D00000}'; // [IN ] UEFIc 933 | CLSID_CFormatUEFIs : TGUID = '{23170F69-40C1-278A-1000-000110D10000}'; // [IN ] UEFIs 934 | CLSID_CFormatSquashFS : TGUID = '{23170F69-40C1-278A-1000-000110D20000}'; // [IN ] SquashFS 935 | CLSID_CFormatCramFS : TGUID = '{23170F69-40C1-278A-1000-000110D30000}'; // [IN ] CramFS 936 | CLSID_CFormatAPM : TGUID = '{23170F69-40C1-278A-1000-000110D40000}'; // [IN ] APM 937 | CLSID_CFormatMslz : TGUID = '{23170F69-40C1-278A-1000-000110D50000}'; // [IN ] MsLZ 938 | CLSID_CFormatFlv : TGUID = '{23170F69-40C1-278A-1000-000110D60000}'; // [IN ] FLV 939 | CLSID_CFormatSwf : TGUID = '{23170F69-40C1-278A-1000-000110D70000}'; // [IN ] SWF 940 | CLSID_CFormatSwfc : TGUID = '{23170F69-40C1-278A-1000-000110D80000}'; // [IN ] SWFC 941 | CLSID_CFormatNtfs : TGUID = '{23170F69-40C1-278A-1000-000110D90000}'; // [IN ] NTFS 942 | CLSID_CFormatFat : TGUID = '{23170F69-40C1-278A-1000-000110DA0000}'; // [IN ] FAT 943 | CLSID_CFormatMbr : TGUID = '{23170F69-40C1-278A-1000-000110DB0000}'; // [IN ] MBR 944 | CLSID_CFormatVhd : TGUID = '{23170F69-40C1-278A-1000-000110DC0000}'; // [IN ] VHD 945 | CLSID_CFormatPe : TGUID = '{23170F69-40C1-278A-1000-000110DD0000}'; // [IN ] PE (Windows Exe) 946 | CLSID_CFormatElf : TGUID = '{23170F69-40C1-278A-1000-000110DE0000}'; // [IN ] ELF (Linux Exe) 947 | CLSID_CFormatMachO : TGUID = '{23170F69-40C1-278A-1000-000110DF0000}'; // [IN ] Mach-O 948 | CLSID_CFormatUdf : TGUID = '{23170F69-40C1-278A-1000-000110E00000}'; // [IN ] iso 949 | CLSID_CFormatXar : TGUID = '{23170F69-40C1-278A-1000-000110E10000}'; // [IN ] xar 950 | CLSID_CFormatMub : TGUID = '{23170F69-40C1-278A-1000-000110E20000}'; // [IN ] mub 951 | CLSID_CFormatHfs : TGUID = '{23170F69-40C1-278A-1000-000110E30000}'; // [IN ] HFS 952 | CLSID_CFormatDmg : TGUID = '{23170F69-40C1-278A-1000-000110E40000}'; // [IN ] dmg 953 | CLSID_CFormatCompound : TGUID = '{23170F69-40C1-278A-1000-000110E50000}'; // [IN ] msi doc xls ppt 954 | CLSID_CFormatWim : TGUID = '{23170F69-40C1-278A-1000-000110E60000}'; // [OUT] wim swm 955 | CLSID_CFormatIso : TGUID = '{23170F69-40C1-278A-1000-000110E70000}'; // [IN ] iso 956 | CLSID_CFormatBkf : TGUID = '{23170F69-40C1-278A-1000-000110E80000}'; // [IN ] BKF 957 | CLSID_CFormatChm : TGUID = '{23170F69-40C1-278A-1000-000110E90000}'; // [IN ] chm chi chq chw hxs hxi hxr hxq hxw lit 958 | CLSID_CFormatSplit : TGUID = '{23170F69-40C1-278A-1000-000110EA0000}'; // [IN ] 001 959 | CLSID_CFormatRpm : TGUID = '{23170F69-40C1-278A-1000-000110EB0000}'; // [IN ] rpm 960 | CLSID_CFormatDeb : TGUID = '{23170F69-40C1-278A-1000-000110EC0000}'; // [IN ] deb 961 | CLSID_CFormatCpio : TGUID = '{23170F69-40C1-278A-1000-000110ED0000}'; // [IN ] cpio 962 | CLSID_CFormatTar : TGUID = '{23170F69-40C1-278A-1000-000110EE0000}'; // [OUT] tar 963 | CLSID_CFormatGZip : TGUID = '{23170F69-40C1-278A-1000-000110EF0000}'; // [OUT] gz gzip tgz tpz 964 | 965 | //fix or copy from Jedi JCL 966 | // ZipHandlerOut.cpp 967 | const 968 | kDeflateAlgoX1 = 0 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kLzAlgoX1' {$ENDIF} {$ENDIF}; 969 | kLzAlgoX1 = 0; 970 | kDeflateAlgoX5 = 1 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kLzAlgoX5' {$ENDIF} {$ENDIF}; 971 | kLzAlgoX5 = 1; 972 | 973 | kDeflateNumPassesX1 = 1; 974 | kDeflateNumPassesX7 = 3; 975 | kDeflateNumPassesX9 = 10; 976 | 977 | kNumFastBytesX1 = 32 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kDeflateNumFastBytesX1' {$ENDIF} {$ENDIF}; 978 | kDeflateNumFastBytesX1 = 32; 979 | kNumFastBytesX7 = 64 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kDeflateNumFastBytesX7' {$ENDIF} {$ENDIF}; 980 | kDeflateNumFastBytesX7 = 64; 981 | kNumFastBytesX9 = 128 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kDeflateNumFastBytesX9' {$ENDIF} {$ENDIF}; 982 | kDeflateNumFastBytesX9 = 128; 983 | 984 | kLzmaNumFastBytesX1 = 32; 985 | kLzmaNumFastBytesX7 = 64; 986 | 987 | kBZip2NumPassesX1 = 1; 988 | kBZip2NumPassesX7 = 2; 989 | kBZip2NumPassesX9 = 7; 990 | 991 | kBZip2DicSizeX1 = 100000; 992 | kBZip2DicSizeX3 = 500000; 993 | kBZip2DicSizeX5 = 900000; 994 | 995 | // HandlerOut.cpp 996 | const 997 | kLzmaAlgoX1 = 0; 998 | kLzmaAlgoX5 = 1; 999 | 1000 | kLzmaDicSizeX1 = 1 shl 16; 1001 | kLzmaDicSizeX3 = 1 shl 20; 1002 | kLzmaDicSizeX5 = 1 shl 24; 1003 | kLzmaDicSizeX7 = 1 shl 25; 1004 | kLzmaDicSizeX9 = 1 shl 26; 1005 | 1006 | kLzmaFastBytesX1 = 32; 1007 | kLzmaFastBytesX7 = 64; 1008 | 1009 | kPpmdMemSizeX1 = (1 shl 22); 1010 | kPpmdMemSizeX5 = (1 shl 24); 1011 | kPpmdMemSizeX7 = (1 shl 26); 1012 | kPpmdMemSizeX9 = (192 shl 20); 1013 | 1014 | kPpmdOrderX1 = 4; 1015 | kPpmdOrderX5 = 6; 1016 | kPpmdOrderX7 = 16; 1017 | kPpmdOrderX9 = 32; 1018 | 1019 | kDeflateFastBytesX1 = 32; 1020 | kDeflateFastBytesX7 = 64; 1021 | kDeflateFastBytesX9 = 128; 1022 | 1023 | implementation 1024 | 1025 | const 1026 | MAXCHECK : int64 = (1 shl 20); 1027 | ZipCompressionMethod: array[TZipCompressionMethod] of UnicodeString = ('COPY', 'DEFLATE', 'DEFLATE64', 'BZIP2', 'LZMA', 'PPMD'); 1028 | ZipEncryptionMethod: array[TZipEncryptionMethod] of UnicodeString = ('AES128', 'AES192', 'AES256', 'ZIPCRYPTO'); 1029 | SevCompressionMethod: array[T7zCompressionMethod] of UnicodeString = ('COPY', 'LZMA', 'BZIP2', 'PPMD', 'DEFLATE', 'DEFLATE64'); 1030 | 1031 | {$IFDEF MSWINDOWS} 1032 | function DateTimeToFileTime(dt: TDateTime): TFileTime; 1033 | var 1034 | st: TSystemTime; 1035 | begin 1036 | DateTimeToSystemTime(dt, st); 1037 | if not (SystemTimeToFileTime(st, Result) and LocalFileTimeToFileTime(Result, Result)) 1038 | then RaiseLastOSError; 1039 | end; 1040 | 1041 | function FileTimeToDateTime(ft: TFileTime): TDateTime; 1042 | var 1043 | st: TSystemTime; 1044 | begin 1045 | if not (FileTimeToLocalFileTime(ft, ft) and FileTimeToSystemTime(ft, st)) then 1046 | RaiseLastOSError; 1047 | Result := SystemTimeToDateTime(st); 1048 | end; 1049 | 1050 | function CurrentFileTime: TFileTime; 1051 | begin 1052 | GetSystemTimeAsFileTime(Result); 1053 | end; 1054 | {$ENDIF MSWINDOWS} 1055 | 1056 | procedure RINOK(const hr: HRESULT); 1057 | begin 1058 | //fix by flying wang. 1059 | if hr = kCallBackError then 1060 | begin 1061 | raise Exception.Create('Callback error.'); 1062 | exit; 1063 | end; 1064 | if (hr = kCallbackCANCEL) or (hr = kCallbackIGNORE) then 1065 | begin 1066 | exit; 1067 | end; 1068 | if hr <> S_OK then 1069 | raise Exception.Create(SysErrorMessage(hr)); 1070 | end; 1071 | 1072 | procedure SetCardinalProperty(arch: I7zOutArchive; const name: UnicodeString; card: Cardinal); 1073 | var 1074 | value: OleVariant; 1075 | begin 1076 | TPropVariant(value).vt := VT_UI4; 1077 | TPropVariant(value).ulVal := card; 1078 | arch.SetPropertie(name, value); 1079 | end; 1080 | 1081 | procedure SetBooleanProperty(arch: I7zOutArchive; const name: UnicodeString; bool: boolean); 1082 | begin 1083 | case bool of 1084 | true: arch.SetPropertie(name, 'ON'); 1085 | false: arch.SetPropertie(name, 'OFF'); 1086 | end; 1087 | end; 1088 | 1089 | procedure SetCompressionLevel(Arch: I7zOutArchive; level: Cardinal); 1090 | begin 1091 | SetCardinalProperty(arch, 'X', level); 1092 | end; 1093 | 1094 | procedure SetMultiThreading(Arch: I7zOutArchive; ThreadCount: Cardinal); 1095 | begin 1096 | SetCardinalProperty(arch, 'MT', ThreadCount); 1097 | end; 1098 | 1099 | procedure SetCompressionMethod(Arch: I7zOutArchive; method: TZipCompressionMethod); 1100 | begin 1101 | Arch.SetPropertie('M', ZipCompressionMethod[method]); 1102 | end; 1103 | 1104 | procedure SetEncryptionMethod(Arch: I7zOutArchive; method: TZipEncryptionMethod); 1105 | begin 1106 | Arch.SetPropertie('EM', ZipEncryptionMethod[method]); 1107 | end; 1108 | 1109 | procedure SetDictionnarySize(Arch: I7zOutArchive; size: Cardinal); 1110 | begin 1111 | SetCardinalProperty(arch, 'D', size); 1112 | end; 1113 | 1114 | procedure SetMemorySize(Arch: I7zOutArchive; size: Cardinal); 1115 | begin 1116 | SetCardinalProperty(arch, 'MEM', size); 1117 | end; 1118 | 1119 | procedure SetDeflateNumPasses(Arch: I7zOutArchive; pass: Cardinal); 1120 | begin 1121 | SetCardinalProperty(arch, 'PASS', pass); 1122 | end; 1123 | 1124 | procedure SetNumFastBytes(Arch: I7zOutArchive; fb: Cardinal); 1125 | begin 1126 | SetCardinalProperty(arch, 'FB', fb); 1127 | end; 1128 | 1129 | procedure SetNumMatchFinderCycles(Arch: I7zOutArchive; mc: Cardinal); 1130 | begin 1131 | SetCardinalProperty(arch, 'MC', mc); 1132 | end; 1133 | 1134 | procedure SevenZipSetCompressionMethod(Arch: I7zOutArchive; method: T7zCompressionMethod); 1135 | begin 1136 | Arch.SetPropertie('0', SevCompressionMethod[method]); 1137 | end; 1138 | 1139 | procedure SevenZipSetBindInfo(Arch: I7zOutArchive; const bind: UnicodeString); 1140 | begin 1141 | arch.SetPropertie('B', bind); 1142 | end; 1143 | 1144 | procedure SevenZipSetSolidSettings(Arch: I7zOutArchive; solid: boolean); 1145 | begin 1146 | SetBooleanProperty(Arch, 'S', solid); 1147 | end; 1148 | 1149 | procedure SevenZipRemoveSfxBlock(Arch: I7zOutArchive; remove: boolean); 1150 | begin 1151 | SetBooleanProperty(Arch, 'RSFX', remove); 1152 | end; 1153 | 1154 | procedure SevenZipAutoFilter(Arch: I7zOutArchive; auto: boolean); 1155 | begin 1156 | SetBooleanProperty(Arch, 'F', auto); 1157 | end; 1158 | 1159 | procedure SevenZipCompressHeaders(Arch: I7zOutArchive; compress: boolean); 1160 | begin 1161 | SetBooleanProperty(Arch, 'HC', compress); 1162 | end; 1163 | 1164 | procedure SevenZipCompressHeadersFull(Arch: I7zOutArchive; compress: boolean); 1165 | begin 1166 | SetBooleanProperty(arch, 'HCF', compress); 1167 | end; 1168 | 1169 | procedure SevenZipEncryptHeaders(Arch: I7zOutArchive; Encrypt: boolean); 1170 | begin 1171 | SetBooleanProperty(arch, 'HE', Encrypt); 1172 | end; 1173 | 1174 | procedure SevenZipVolumeMode(Arch: I7zOutArchive; Mode: boolean); 1175 | begin 1176 | SetBooleanProperty(arch, 'V', Mode); 1177 | end; 1178 | 1179 | function LoadModule(FileName: string): THandle; 1180 | {$IFDEF MSWINDOWS} 1181 | begin 1182 | Result := SafeLoadLibrary(FileName); 1183 | end; 1184 | {$ENDIF MSWINDOWS} 1185 | {$IFDEF POSIX} 1186 | begin 1187 | Result := dlopen(PChar(FileName), RTLD_NOW); 1188 | end; 1189 | {$ENDIF POSIX} 1190 | 1191 | procedure UnloadModule(var Module: THandle); 1192 | {$IFDEF MSWINDOWS} 1193 | begin 1194 | if Module <> 0 then 1195 | FreeLibrary(Module); 1196 | Module := 0; 1197 | end; 1198 | {$ENDIF MSWINDOWS} 1199 | {$IFDEF POSIX} 1200 | begin 1201 | if Module <> 0 then 1202 | dlclose(Pointer(Module)); 1203 | Module := 0; 1204 | end; 1205 | {$ENDIF POSIX} 1206 | 1207 | function GetModuleSymbol(Module: THandle; SymbolName: string): Pointer; 1208 | {$IFDEF MSWINDOWS} 1209 | begin 1210 | Result := nil; 1211 | if Module <> 0 then 1212 | Result := GetProcAddress(Module, PChar(SymbolName)); 1213 | end; 1214 | {$ENDIF MSWINDOWS} 1215 | {$IFDEF POSIX} 1216 | begin 1217 | Result := nil; 1218 | if Module <> 0 then 1219 | Result := dlsym(Module, PChar(SymbolName)); 1220 | end; 1221 | {$ENDIF POSIX} 1222 | 1223 | type 1224 | T7zPlugin = class(TInterfacedObject) 1225 | private 1226 | FHandle: THandle; 1227 | FCreateObject: function(const clsid, iid :TGUID; var outObject): HRESULT; stdcall; 1228 | public 1229 | constructor Create(const lib: string); virtual; 1230 | destructor Destroy; override; 1231 | procedure CreateObject(const clsid, iid :TGUID; var obj); 1232 | end; 1233 | 1234 | T7zCodec = class(T7zPlugin, I7zCodec, ICompressProgressInfo) 1235 | private 1236 | FGetMethodProperty: function(index: Cardinal; propID: NMethodPropID; var value: OleVariant): HRESULT; stdcall; 1237 | FGetNumberOfMethods: function(numMethods: PCardinal): HRESULT; stdcall; 1238 | function GetNumberOfMethods: Cardinal; 1239 | function GetMethodProperty(index: Cardinal; propID: NMethodPropID): OleVariant; 1240 | function GetName(const index: integer): string; 1241 | protected 1242 | function SetRatioInfo(inSize, outSize: PInt64): HRESULT; stdcall; 1243 | public 1244 | function GetDecoder(const index: integer): ICompressCoder; 1245 | function GetEncoder(const index: integer): ICompressCoder; 1246 | constructor Create(const lib: string); override; 1247 | property MethodProperty[index: Cardinal; propID: NMethodPropID]: OleVariant read GetMethodProperty; 1248 | property NumberOfMethods: Cardinal read GetNumberOfMethods; 1249 | property Name[const index: integer]: string read GetName; 1250 | end; 1251 | 1252 | T7zArchive = class(T7zPlugin) 1253 | private 1254 | FGetHandlerProperty: function(propID: NHandlerPropID; var value: OleVariant): HRESULT; stdcall; 1255 | FClassId: TGUID; 1256 | procedure SetClassId(const classid: TGUID); 1257 | function GetClassId: TGUID; 1258 | public 1259 | function GetHandlerProperty(const propID: NHandlerPropID): OleVariant; 1260 | function GetLibStringProperty(const Index: NHandlerPropID): string; 1261 | function GetLibGUIDProperty(const Index: NHandlerPropID): TGUID; 1262 | constructor Create(const lib: string); override; 1263 | property HandlerProperty[const propID: NHandlerPropID]: OleVariant read GetHandlerProperty; 1264 | property Name: string index kName read GetLibStringProperty; 1265 | property ClassID: TGUID read GetClassId write SetClassId; 1266 | property Extension: string index kExtension read GetLibStringProperty; 1267 | end; 1268 | 1269 | T7zInArchive = class(T7zArchive, I7zInArchive, IProgress, IArchiveOpenCallback, 1270 | IArchiveExtractCallback, ICryptoGetTextPassword, IArchiveOpenVolumeCallback, 1271 | IArchiveOpenSetSubArchiveName) 1272 | private 1273 | //fix by flying wang. 1274 | FLastWriteFileAttr: Cardinal; 1275 | FLastWriteFileDataTime: TDateTime; 1276 | FLastWriteFile: string; 1277 | FInArchive: IInArchive; 1278 | FPasswordCallback: T7zPasswordCallback; 1279 | FPasswordSender: Pointer; 1280 | FProgressCallback: T7zProgressCallback; 1281 | FProgressSender: Pointer; 1282 | //fix by 刘志林 1283 | FProgressExceptCallback: T7zProgressExceptCallback; 1284 | FProgressExceptSender: Pointer; 1285 | FStream: TStream; 1286 | FPasswordIsDefined: Boolean; 1287 | FPassword: UnicodeString; 1288 | FSubArchiveMode: Boolean; 1289 | FSubArchiveName: UnicodeString; 1290 | FExtractCallBack: T7zGetStreamCallBack; 1291 | FExtractSender: Pointer; 1292 | FExtractPath: string; 1293 | function GetInArchive: IInArchive; 1294 | function GetItemProp(const Item: Cardinal; prop: PROPID): OleVariant; 1295 | //fix by flying wang. 1296 | procedure ResetLastFileInfo; 1297 | protected 1298 | // I7zInArchive 1299 | procedure OpenFile(const filename: string); stdcall; 1300 | procedure OpenStream(stream: IInStream); stdcall; 1301 | procedure Close; stdcall; 1302 | function GetNumberOfItems: Cardinal; stdcall; 1303 | function GetItemPath(const index: integer): UnicodeString; stdcall; 1304 | function GetItemName(const index: integer): UnicodeString; stdcall; 1305 | function GetItemSize(const index: integer): Int64; stdcall; stdcall; 1306 | //fix by flying wang. 1307 | function GetItemCompressedSize(const index: integer): Int64; stdcall; 1308 | {$IFDEF MSWINDOWS} 1309 | function GetItemFileTime(const index: integer): TFileTime; stdcall; 1310 | {$ENDIF MSWINDOWS} 1311 | function GetItemDataTime(const index: integer): TDateTime; stdcall; 1312 | function GetItemIsFolder(const index: integer): boolean; stdcall; 1313 | procedure ExtractItem(const item: Cardinal; Stream: TStream; test: longbool); stdcall; 1314 | //fix or add by ekot1 1315 | procedure ExtractItemToPath(const item: Cardinal; const path: string; test: longbool); stdcall; 1316 | procedure ExtractItems(items: PCardArray; count: cardinal; test: longbool; sender: pointer; callback: T7zGetStreamCallBack); stdcall; 1317 | procedure SetPasswordCallback(sender: Pointer; callback: T7zPasswordCallback); stdcall; 1318 | procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall; 1319 | //fix by 刘志林 1320 | procedure SetProgressExceptCallback(sender: Pointer; callback: T7zProgressExceptCallback); stdcall; 1321 | procedure ExtractAll(test: longbool; sender: pointer; callback: T7zGetStreamCallBack); stdcall; 1322 | procedure ExtractTo(const path: string); stdcall; 1323 | procedure SetPassword(const password: UnicodeString); stdcall; 1324 | // IArchiveOpenCallback 1325 | function SetTotal(files, bytes: PInt64): HRESULT; overload; stdcall; 1326 | function SetCompleted(files, bytes: PInt64): HRESULT; overload; stdcall; 1327 | // IProgress 1328 | function SetTotal(total: Int64): HRESULT; overload; stdcall; 1329 | function SetCompleted(completeValue: PInt64): HRESULT; overload; stdcall; 1330 | // IArchiveExtractCallback 1331 | function GetStream(index: Cardinal; var outStream: ISequentialOutStream; 1332 | askExtractMode: NAskMode): HRESULT; overload; stdcall; 1333 | function PrepareOperation(askExtractMode: NAskMode): HRESULT; stdcall; 1334 | function SetOperationResult(resultEOperationResult: NExtOperationResult): HRESULT; overload; stdcall; 1335 | // ICryptoGetTextPassword 1336 | function CryptoGetTextPassword(var password: TBStr): HRESULT; stdcall; 1337 | // IArchiveOpenVolumeCallback 1338 | function GetProperty(propID: PROPID; var value: OleVariant): HRESULT; overload; stdcall; 1339 | function GetStream(const name: PWideChar; var inStream: IInStream): HRESULT; overload; stdcall; 1340 | // IArchiveOpenSetSubArchiveName 1341 | function SetSubArchiveName(name: PWideChar): HRESULT; stdcall; 1342 | 1343 | public 1344 | constructor Create(const lib: string); override; 1345 | destructor Destroy; override; 1346 | property InArchive: IInArchive read GetInArchive; 1347 | end; 1348 | 1349 | T7zOutArchive = class(T7zArchive, I7zOutArchive, IArchiveUpdateCallback, ICryptoGetTextPassword2) 1350 | private 1351 | FOutArchive: IOutArchive; 1352 | FBatchList: TObjectList; 1353 | FProgressCallback: T7zProgressCallback; 1354 | FProgressSender: Pointer; 1355 | FPassword: UnicodeString; 1356 | function GetOutArchive: IOutArchive; 1357 | protected 1358 | // I7zOutArchive 1359 | procedure AddStream(Stream: TStream; Ownership: TStreamOwnership; 1360 | Attributes: Cardinal; CreationTime, LastWriteTime: TFileTime; 1361 | const Path: UnicodeString; IsFolder, IsAnti: boolean); stdcall; 1362 | procedure AddFile(const Filename: TFileName; const Path: UnicodeString); stdcall; 1363 | procedure AddFiles(const Dir, Path, Wildcard: string; recurse, IncludeEmptyDir: boolean); stdcall; 1364 | procedure SaveToFile(const FileName: TFileName); stdcall; 1365 | procedure SaveToStream(stream: TStream); stdcall; 1366 | procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall; 1367 | procedure ClearBatch; stdcall; 1368 | procedure SetPassword(const password: UnicodeString); stdcall; 1369 | procedure SetPropertie(name: UnicodeString; value: OleVariant); stdcall; 1370 | // IProgress 1371 | function SetTotal(total: Int64): HRESULT; stdcall; 1372 | function SetCompleted(completeValue: PInt64): HRESULT; stdcall; 1373 | // IArchiveUpdateCallback 1374 | function GetUpdateItemInfo(index: Cardinal; 1375 | newData: PInteger; // 1 - new data, 0 - old data 1376 | newProperties: PInteger; // 1 - new properties, 0 - old properties 1377 | indexInArchive: PCardinal // -1 if there is no in archive, or if doesn't matter 1378 | ): HRESULT; stdcall; 1379 | function GetProperty(index: Cardinal; propID: PROPID; var value: OleVariant): HRESULT; stdcall; 1380 | function GetStream(index: Cardinal; var inStream: ISequentialInStream): HRESULT; stdcall; 1381 | function SetOperationResult(operationResult: Integer): HRESULT; stdcall; 1382 | // ICryptoGetTextPassword2 1383 | function CryptoGetTextPassword2(passwordIsDefined: PInteger; var password: TBStr): HRESULT; stdcall; 1384 | public 1385 | constructor Create(const lib: string); override; 1386 | destructor Destroy; override; 1387 | property OutArchive: IOutArchive read GetOutArchive; 1388 | end; 1389 | 1390 | function CreateInArchive(const classid: TGUID; const lib: string): I7zInArchive; 1391 | begin 1392 | Result := T7zInArchive.Create(G_7zWorkPath + lib); 1393 | Result.ClassId := classid; 1394 | end; 1395 | 1396 | function CreateOutArchive(const classid: TGUID; const lib: string): I7zOutArchive; 1397 | begin 1398 | Result := T7zOutArchive.Create(G_7zWorkPath + lib); 1399 | Result.ClassId := classid; 1400 | end; 1401 | 1402 | 1403 | { T7zPlugin } 1404 | 1405 | constructor T7zPlugin.Create(const lib: string); 1406 | begin 1407 | inherited Create; 1408 | FHandle := LoadModule(PChar(lib)); 1409 | if FHandle = 0 then 1410 | begin 1411 | try 1412 | RaiseLastOSError; 1413 | except 1414 | on E: Exception do 1415 | begin 1416 | raise Exception.CreateFmt('Error loading library %s' + sLineBreak + 'Error Message: ' + E.Message, [lib]); 1417 | end; 1418 | end; 1419 | end; 1420 | FCreateObject := GetModuleSymbol(FHandle, 'CreateObject'); 1421 | if not (Assigned(FCreateObject)) then 1422 | begin 1423 | FreeLibrary(FHandle); 1424 | raise Exception.CreateFmt('%s is not a 7z library', [lib]); 1425 | end; 1426 | end; 1427 | 1428 | destructor T7zPlugin.Destroy; 1429 | begin 1430 | UnloadModule(FHandle); 1431 | inherited; 1432 | end; 1433 | 1434 | procedure T7zPlugin.CreateObject(const clsid, iid: TGUID; var obj); 1435 | var 1436 | hr: HRESULT; 1437 | begin 1438 | hr := FCreateObject(clsid, iid, obj); 1439 | if failed(hr) then 1440 | raise Exception.Create(SysErrorMessage(hr)); 1441 | end; 1442 | 1443 | { T7zCodec } 1444 | 1445 | constructor T7zCodec.Create(const lib: string); 1446 | begin 1447 | inherited; 1448 | FGetMethodProperty := GetModuleSymbol(FHandle, 'GetMethodProperty'); 1449 | FGetNumberOfMethods := GetModuleSymbol(FHandle, 'GetNumberOfMethods'); 1450 | if not (Assigned(FGetMethodProperty) and Assigned(FGetNumberOfMethods)) then 1451 | begin 1452 | FreeLibrary(FHandle); 1453 | raise Exception.CreateFmt('%s is not a codec library', [lib]); 1454 | end; 1455 | end; 1456 | 1457 | function T7zCodec.GetDecoder(const index: integer): ICompressCoder; 1458 | var 1459 | v: OleVariant; 1460 | begin 1461 | v := MethodProperty[index, kDecoder]; 1462 | CreateObject(TPropVariant(v).puuid^, ICompressCoder, Result); 1463 | end; 1464 | 1465 | function T7zCodec.GetEncoder(const index: integer): ICompressCoder; 1466 | var 1467 | v: OleVariant; 1468 | begin 1469 | v := MethodProperty[index, kEncoder]; 1470 | CreateObject(TPropVariant(v).puuid^, ICompressCoder, Result); 1471 | end; 1472 | 1473 | function T7zCodec.GetMethodProperty(index: Cardinal; 1474 | propID: NMethodPropID): OleVariant; 1475 | var 1476 | hr: HRESULT; 1477 | begin 1478 | hr := FGetMethodProperty(index, propID, Result); 1479 | if Failed(hr) then 1480 | raise Exception.Create(SysErrorMessage(hr)); 1481 | end; 1482 | 1483 | function T7zCodec.GetName(const index: integer): string; 1484 | begin 1485 | Result := MethodProperty[index, kMethodName]; 1486 | end; 1487 | 1488 | function T7zCodec.GetNumberOfMethods: Cardinal; 1489 | var 1490 | hr: HRESULT; 1491 | begin 1492 | hr := FGetNumberOfMethods(@Result); 1493 | if Failed(hr) then 1494 | raise Exception.Create(SysErrorMessage(hr)); 1495 | end; 1496 | 1497 | 1498 | function T7zCodec.SetRatioInfo(inSize, outSize: PInt64): HRESULT; 1499 | begin 1500 | Result := S_OK; 1501 | end; 1502 | 1503 | { T7zInArchive } 1504 | 1505 | procedure T7zInArchive.Close; stdcall; 1506 | begin 1507 | //fix by flying wang. 1508 | ResetLastFileInfo; 1509 | FPasswordIsDefined := false; 1510 | FSubArchiveMode := false; 1511 | FInArchive.Close; 1512 | FInArchive := nil; 1513 | end; 1514 | 1515 | constructor T7zInArchive.Create(const lib: string); 1516 | begin 1517 | inherited; 1518 | //fix by flying wang. 1519 | ResetLastFileInfo; 1520 | FPasswordCallback := nil; 1521 | FPasswordSender := nil; 1522 | FPasswordIsDefined := false; 1523 | FSubArchiveMode := false; 1524 | FExtractCallBack := nil; 1525 | FExtractSender := nil; 1526 | end; 1527 | 1528 | destructor T7zInArchive.Destroy; 1529 | begin 1530 | FInArchive := nil; 1531 | inherited; 1532 | end; 1533 | 1534 | procedure T7zInArchive.ResetLastFileInfo; 1535 | begin 1536 | //fix by flying wang. 1537 | FLastWriteFileAttr := faNormal; 1538 | FLastWriteFileDataTime := MinDateTime; 1539 | FLastWriteFile := ''; 1540 | end; 1541 | 1542 | function T7zInArchive.GetInArchive: IInArchive; 1543 | begin 1544 | if FInArchive = nil then 1545 | CreateObject(ClassID, IInArchive, FInArchive); 1546 | Result := FInArchive; 1547 | end; 1548 | 1549 | function T7zInArchive.GetItemPath(const index: integer): UnicodeString; stdcall; 1550 | begin 1551 | Result := UnicodeString(GetItemProp(index, kpidPath)); 1552 | end; 1553 | 1554 | function T7zInArchive.GetNumberOfItems: Cardinal; stdcall; 1555 | begin 1556 | RINOK(FInArchive.GetNumberOfItems(Result)); 1557 | end; 1558 | 1559 | procedure T7zInArchive.OpenFile(const filename: string); stdcall; 1560 | var 1561 | strm: IInStream; 1562 | begin 1563 | //fix by flying wang. 1564 | ResetLastFileInfo; 1565 | strm := T7zStream.Create(TFileStream.Create(filename, fmOpenRead or fmShareDenyNone), soOwned); 1566 | try 1567 | RINOK( 1568 | InArchive.Open( 1569 | strm, 1570 | @MAXCHECK, self as IArchiveOpenCallBack 1571 | ) 1572 | ); 1573 | finally 1574 | strm := nil; 1575 | end; 1576 | end; 1577 | 1578 | procedure T7zInArchive.OpenStream(stream: IInStream); stdcall; 1579 | begin 1580 | //fix by flying wang. 1581 | ResetLastFileInfo; 1582 | RINOK(InArchive.Open(stream, @MAXCHECK, self as IArchiveOpenCallBack)); 1583 | end; 1584 | 1585 | function T7zInArchive.GetItemIsFolder(const index: integer): boolean; stdcall; 1586 | begin 1587 | Result := Boolean(GetItemProp(index, kpidIsDir)); 1588 | end; 1589 | 1590 | function T7zInArchive.GetItemProp(const Item: Cardinal; 1591 | prop: PROPID): OleVariant; 1592 | begin 1593 | FInArchive.GetProperty(Item, prop, Result); 1594 | end; 1595 | 1596 | procedure T7zInArchive.ExtractItem(const item: Cardinal; Stream: TStream; test: longbool); stdcall; 1597 | begin 1598 | FStream := Stream; 1599 | try 1600 | if test then 1601 | RINOK(FInArchive.Extract(@item, 1, 1, self as IArchiveExtractCallback)) else 1602 | RINOK(FInArchive.Extract(@item, 1, 0, self as IArchiveExtractCallback)); 1603 | finally 1604 | FStream := nil; 1605 | end; 1606 | end; 1607 | 1608 | //fix or add by ekot1 1609 | procedure T7zInArchive.ExtractItemToPath(const item: Cardinal; const path: string; test: longbool); stdcall; 1610 | begin 1611 | FExtractPath := IncludeTrailingPathDelimiter(path); 1612 | try 1613 | if test then 1614 | RINOK(FInArchive.Extract(@item, 1, 1, self as IArchiveExtractCallback)) else 1615 | RINOK(FInArchive.Extract(@item, 1, 0, self as IArchiveExtractCallback)); 1616 | finally 1617 | FExtractPath := ''; 1618 | end; 1619 | end; 1620 | 1621 | function T7zInArchive.GetStream(index: Cardinal; 1622 | var outStream: ISequentialOutStream; askExtractMode: NAskMode): HRESULT; 1623 | var 1624 | path: string; 1625 | //fix by 刘志林 1626 | nFileStream: TFileStream; 1627 | nECR: NECallBack; 1628 | begin 1629 | if askExtractMode = kExtract then 1630 | if FStream <> nil then 1631 | outStream := T7zStream.Create(FStream, soReference) as ISequentialOutStream else 1632 | if assigned(FExtractCallback) then 1633 | begin 1634 | Result := FExtractCallBack(FExtractSender, index, outStream); 1635 | Exit; 1636 | end else 1637 | if FExtractPath <> '' then 1638 | begin 1639 | //fix by 刘志林 and flying wang. 1640 | if GetItemIsFolder(index) then 1641 | begin 1642 | path := FExtractPath + GetItemPath(index); 1643 | ForceDirectories(path); 1644 | end 1645 | else 1646 | begin 1647 | path := FExtractPath + GetItemPath(index); 1648 | ForceDirectories(ExtractFilePath(path)); 1649 | FLastWriteFileAttr := 0; 1650 | if FileExists(path) then 1651 | begin 1652 | FLastWriteFileAttr := FileGetAttr(path); 1653 | if FLastWriteFileAttr <> faNormal then 1654 | FileSetAttr(path, faNormal); 1655 | end; 1656 | 1657 | nFileStream := nil; 1658 | repeat 1659 | try 1660 | //能写入即可。 1661 | nFileStream := TFileStream.Create(Path, fmCreate or fmOpenReadWrite or fmShareDenyWrite); 1662 | //建立文件大小。 1663 | nFileStream.Size := GetItemSize(index); 1664 | nFileStream.Position := 0; 1665 | except 1666 | FreeAndNil(nFileStream); 1667 | if not Assigned(FProgressExceptCallback) then 1668 | nECR := EC_CANCEL 1669 | else 1670 | nECR := FProgressExceptCallback(FProgressExceptSender, Path); 1671 | end; 1672 | until (nFileStream <> nil) or (nECR <> EC_RETRY); 1673 | if nFileStream = nil then 1674 | begin 1675 | if nECR = EC_CANCEL then 1676 | begin 1677 | Result := kCallbackCANCEL; 1678 | Exit; 1679 | end; 1680 | end 1681 | else 1682 | begin 1683 | FreeAndNil(nFileStream); 1684 | FLastWriteFileDataTime := GetItemDataTime(index); 1685 | FLastWriteFile := path; 1686 | if (FLastWriteFileAttr <> 0) and (FLastWriteFileAttr <> faNormal) then 1687 | FileSetAttr(FLastWriteFile, FLastWriteFileAttr); 1688 | FileSetDate(FLastWriteFile, DateTimeToFileDate(FLastWriteFileDataTime)); 1689 | outStream := T7zStream.Create(TFileStream.Create(path, fmCreate), soOwned); 1690 | end; 1691 | end; 1692 | end; 1693 | Result := S_OK; 1694 | end; 1695 | 1696 | function T7zInArchive.PrepareOperation(askExtractMode: NAskMode): HRESULT; 1697 | begin 1698 | Result := S_OK; 1699 | end; 1700 | 1701 | function T7zInArchive.SetCompleted(completeValue: PInt64): HRESULT; 1702 | begin 1703 | //fix by flying wang. 1704 | Result := kCallBackError; 1705 | if Assigned(FProgressCallback) and (completeValue <> nil) then 1706 | Result := FProgressCallback(FProgressSender, false, completeValue^) else 1707 | Result := S_OK; 1708 | end; 1709 | 1710 | function T7zInArchive.SetCompleted(files, bytes: PInt64): HRESULT; 1711 | begin 1712 | Result := S_OK; 1713 | end; 1714 | 1715 | function T7zInArchive.SetOperationResult( 1716 | resultEOperationResult: NExtOperationResult): HRESULT; 1717 | begin 1718 | //fix by flying wang. 1719 | if FileExists(FLastWriteFile) then 1720 | begin 1721 | if (FLastWriteFileAttr <> 0) and (FLastWriteFileAttr <> faNormal) then 1722 | FileSetAttr(FLastWriteFile, FLastWriteFileAttr); 1723 | FileSetDate(FLastWriteFile, DateTimeToFileDate(FLastWriteFileDataTime)); 1724 | end; 1725 | ResetLastFileInfo; 1726 | Result := S_OK; 1727 | end; 1728 | 1729 | function T7zInArchive.SetTotal(total: Int64): HRESULT; 1730 | begin 1731 | //fix by flying wang. 1732 | Result := kCallBackError; 1733 | if Assigned(FProgressCallback) then 1734 | Result := FProgressCallback(FProgressSender, true, total) else 1735 | Result := S_OK; 1736 | end; 1737 | 1738 | function T7zInArchive.SetTotal(files, bytes: PInt64): HRESULT; 1739 | begin 1740 | Result := S_OK; 1741 | end; 1742 | 1743 | function T7zInArchive.CryptoGetTextPassword(var password: TBStr): HRESULT; 1744 | var 1745 | wpass: UnicodeString; 1746 | begin 1747 | if FPasswordIsDefined then 1748 | begin 1749 | password := SysAllocString(PWideChar(FPassword)); 1750 | Result := S_OK; 1751 | end else 1752 | if Assigned(FPasswordCallback) then 1753 | begin 1754 | //fix by flying wang. 1755 | Result := kCallBackError; 1756 | Result := FPasswordCallBack(FPasswordSender, wpass); 1757 | if Result = S_OK then 1758 | begin 1759 | password := SysAllocString(PWideChar(wpass)); 1760 | FPasswordIsDefined := True; 1761 | FPassword := wpass; 1762 | end; 1763 | end else 1764 | Result := S_FALSE; 1765 | end; 1766 | 1767 | function T7zInArchive.GetProperty(propID: PROPID; 1768 | var value: OleVariant): HRESULT; 1769 | begin 1770 | Result := S_OK; 1771 | end; 1772 | 1773 | function T7zInArchive.GetStream(const name: PWideChar; 1774 | var inStream: IInStream): HRESULT; 1775 | begin 1776 | Result := S_OK; 1777 | end; 1778 | 1779 | procedure T7zInArchive.SetPasswordCallback(sender: Pointer; 1780 | callback: T7zPasswordCallback); stdcall; 1781 | begin 1782 | FPasswordSender := sender; 1783 | FPasswordCallback := callback; 1784 | end; 1785 | 1786 | function T7zInArchive.SetSubArchiveName(name: PWideChar): HRESULT; 1787 | begin 1788 | FSubArchiveMode := true; 1789 | FSubArchiveName := name; 1790 | Result := S_OK; 1791 | end; 1792 | 1793 | function T7zInArchive.GetItemName(const index: integer): UnicodeString; stdcall; 1794 | begin 1795 | Result := UnicodeString(GetItemProp(index, kpidName)); 1796 | end; 1797 | 1798 | function T7zInArchive.GetItemSize(const index: integer): Int64; stdcall; 1799 | begin 1800 | Result := Int64(GetItemProp(index, kpidSize)); 1801 | end; 1802 | 1803 | //fix by flying wang. 1804 | function T7zInArchive.GetItemCompressedSize(const index: integer): Int64; stdcall; 1805 | begin 1806 | Result := Int64(GetItemProp(index, kpidPackSize)); 1807 | end; 1808 | 1809 | {$IFDEF MSWINDOWS} 1810 | function T7zInArchive.GetItemFileTime(const index: integer): TFileTime; stdcall; 1811 | var 1812 | value: OleVariant; 1813 | begin 1814 | value := GetItemProp(index, kpidMTime); 1815 | if TPropVariant(value).vt = VT_FILETIME then 1816 | begin 1817 | Result := TPropVariant(value).filetime; 1818 | end; 1819 | end; 1820 | {$ENDIF MSWINDOWS} 1821 | 1822 | function T7zInArchive.GetItemDataTime(const index: integer): TDateTime; stdcall; 1823 | var 1824 | A: TFileTime; 1825 | begin 1826 | Result := MinDateTime; 1827 | A := GetItemFileTime(index); 1828 | Result := FileTimeToDateTime(A); 1829 | end; 1830 | 1831 | procedure T7zInArchive.ExtractItems(items: PCardArray; count: cardinal; test: longbool; 1832 | sender: pointer; callback: T7zGetStreamCallBack); stdcall; 1833 | begin 1834 | FExtractCallBack := callback; 1835 | FExtractSender := sender; 1836 | try 1837 | if test then 1838 | RINOK(FInArchive.Extract(items, count, 1, self as IArchiveExtractCallback)) else 1839 | RINOK(FInArchive.Extract(items, count, 0, self as IArchiveExtractCallback)); 1840 | finally 1841 | FExtractCallBack := nil; 1842 | FExtractSender := nil; 1843 | end; 1844 | end; 1845 | 1846 | procedure T7zInArchive.SetProgressCallback(sender: Pointer; 1847 | callback: T7zProgressCallback); stdcall; 1848 | begin 1849 | FProgressSender := sender; 1850 | FProgressCallback := callback; 1851 | end; 1852 | 1853 | //fix by 刘志林 1854 | procedure T7zInArchive.SetProgressExceptCallback(sender: Pointer; 1855 | callback: T7zProgressExceptCallback); 1856 | begin 1857 | FProgressExceptSender := sender; 1858 | FProgressExceptCallback := callback; 1859 | end; 1860 | 1861 | procedure T7zInArchive.ExtractAll(test: longbool; sender: pointer; 1862 | callback: T7zGetStreamCallBack); 1863 | begin 1864 | FExtractCallBack := callback; 1865 | FExtractSender := sender; 1866 | try 1867 | if test then 1868 | RINOK(FInArchive.Extract(nil, $FFFFFFFF, 1, self as IArchiveExtractCallback)) else 1869 | RINOK(FInArchive.Extract(nil, $FFFFFFFF, 0, self as IArchiveExtractCallback)); 1870 | finally 1871 | FExtractCallBack := nil; 1872 | FExtractSender := nil; 1873 | end; 1874 | end; 1875 | 1876 | procedure T7zInArchive.ExtractTo(const path: string); 1877 | begin 1878 | FExtractPath := IncludeTrailingPathDelimiter(path); 1879 | try 1880 | RINOK(FInArchive.Extract(nil, $FFFFFFFF, 0, self as IArchiveExtractCallback)); 1881 | finally 1882 | FExtractPath := ''; 1883 | end; 1884 | end; 1885 | 1886 | procedure T7zInArchive.SetPassword(const password: UnicodeString); 1887 | begin 1888 | FPassword := password; 1889 | FPasswordIsDefined := FPassword <> ''; 1890 | end; 1891 | 1892 | { T7zArchive } 1893 | 1894 | constructor T7zArchive.Create(const lib: string); 1895 | begin 1896 | inherited; 1897 | FGetHandlerProperty := GetModuleSymbol(FHandle, 'GetHandlerProperty'); 1898 | if not Assigned(FGetHandlerProperty) then 1899 | begin 1900 | FreeLibrary(FHandle); 1901 | raise Exception.CreateFmt('%s is not a Format library', [lib]); 1902 | end; 1903 | FClassId := GUID_NULL; 1904 | end; 1905 | 1906 | function T7zArchive.GetClassId: TGUID; 1907 | begin 1908 | Result := FClassId; 1909 | end; 1910 | 1911 | function T7zArchive.GetHandlerProperty(const propID: NHandlerPropID): OleVariant; 1912 | var 1913 | hr: HRESULT; 1914 | begin 1915 | hr := FGetHandlerProperty(propID, Result); 1916 | if Failed(hr) then 1917 | raise Exception.Create(SysErrorMessage(hr)); 1918 | end; 1919 | 1920 | function T7zArchive.GetLibGUIDProperty(const Index: NHandlerPropID): TGUID; 1921 | var 1922 | v: OleVariant; 1923 | begin 1924 | v := HandlerProperty[index]; 1925 | Result := TPropVariant(v).puuid^; 1926 | end; 1927 | 1928 | function T7zArchive.GetLibStringProperty(const Index: NHandlerPropID): string; 1929 | begin 1930 | Result := HandlerProperty[Index]; 1931 | end; 1932 | 1933 | procedure T7zArchive.SetClassId(const classid: TGUID); 1934 | begin 1935 | FClassId := classid; 1936 | end; 1937 | 1938 | { T7zStream } 1939 | 1940 | constructor T7zStream.Create(Stream: TStream; Ownership: TStreamOwnership); 1941 | begin 1942 | inherited Create; 1943 | FStream := Stream; 1944 | FOwnership := Ownership; 1945 | end; 1946 | 1947 | destructor T7zStream.destroy; 1948 | begin 1949 | if FOwnership = soOwned then 1950 | begin 1951 | FStream.Free; 1952 | FStream := nil; 1953 | end; 1954 | inherited; 1955 | end; 1956 | 1957 | function T7zStream.Flush: HRESULT; 1958 | begin 1959 | Result := S_OK; 1960 | end; 1961 | 1962 | function T7zStream.GetSize(size: PInt64): HRESULT; 1963 | begin 1964 | if size <> nil then 1965 | size^ := FStream.Size; 1966 | Result := S_OK; 1967 | end; 1968 | 1969 | function T7zStream.Read(data: Pointer; size: Cardinal; 1970 | processedSize: PCardinal): HRESULT; 1971 | var 1972 | len: integer; 1973 | begin 1974 | len := FStream.Read(data^, size); 1975 | if processedSize <> nil then 1976 | processedSize^ := len; 1977 | Result := S_OK; 1978 | end; 1979 | 1980 | function T7zStream.Seek(offset: Int64; seekOrigin: Cardinal; 1981 | newPosition: PInt64): HRESULT; 1982 | begin 1983 | FStream.Seek(offset, TSeekOrigin(seekOrigin)); 1984 | if newPosition <> nil then 1985 | newPosition^ := FStream.Position; 1986 | Result := S_OK; 1987 | end; 1988 | 1989 | function T7zStream.SetSize(newSize: Int64): HRESULT; 1990 | begin 1991 | FStream.Size := newSize; 1992 | Result := S_OK; 1993 | end; 1994 | 1995 | function T7zStream.Write(data: Pointer; size: Cardinal; 1996 | processedSize: PCardinal): HRESULT; 1997 | var 1998 | len: integer; 1999 | begin 2000 | len := FStream.Write(data^, size); 2001 | if processedSize <> nil then 2002 | processedSize^ := len; 2003 | Result := S_OK; 2004 | end; 2005 | 2006 | type 2007 | TSourceMode = (smStream, smFile); 2008 | 2009 | T7zBatchItem = class 2010 | SourceMode: TSourceMode; 2011 | Stream: TStream; 2012 | Attributes: Cardinal; 2013 | CreationTime, LastWriteTime: TFileTime; 2014 | Path: UnicodeString; 2015 | IsFolder, IsAnti: boolean; 2016 | FileName: TFileName; 2017 | Ownership: TStreamOwnership; 2018 | Size: Int64; 2019 | destructor Destroy; override; 2020 | end; 2021 | 2022 | destructor T7zBatchItem.Destroy; 2023 | begin 2024 | if (Ownership = soOwned) and (Stream <> nil) then 2025 | Stream.Free; 2026 | inherited; 2027 | end; 2028 | 2029 | { T7zOutArchive } 2030 | 2031 | procedure T7zOutArchive.AddFile(const Filename: TFileName; const Path: UnicodeString); 2032 | var 2033 | item: T7zBatchItem; 2034 | Handle: THandle; 2035 | TempSize: Int64; 2036 | TempSizeHi: Cardinal; 2037 | begin 2038 | if not FileExists(Filename) then exit; 2039 | item := T7zBatchItem.Create; 2040 | Item.SourceMode := smFile; 2041 | item.Stream := nil; 2042 | item.FileName := Filename; 2043 | item.Path := Path; 2044 | Handle := FileOpen(Filename, fmOpenRead or fmShareDenyNone); 2045 | GetFileTime(Handle, @item.CreationTime, nil, @item.LastWriteTime); 2046 | Int64Rec(TempSize).Lo := GetFileSize(Handle, @TempSizeHi); 2047 | Int64Rec(TempSize).Hi := TempSizeHi; 2048 | item.Size := TempSize; 2049 | CloseHandle(Handle); 2050 | //item.Attributes := GetFileAttributes(PChar(Filename)); 2051 | //fix By Flying Wang. 2052 | item.Attributes := FileGetAttr(Filename); 2053 | item.IsFolder := false; 2054 | item.IsAnti := False; 2055 | item.Ownership := soOwned; 2056 | FBatchList.Add(item); 2057 | end; 2058 | 2059 | procedure T7zOutArchive.AddFiles(const Dir, Path, Wildcard: string; recurse, IncludeEmptyDir: boolean); 2060 | var 2061 | lencut: integer; 2062 | willlist: TStringList; 2063 | zedir: string; 2064 | procedure Traverse(p: string); 2065 | var 2066 | f: TSearchRec; 2067 | i: integer; 2068 | item: T7zBatchItem; 2069 | IsEmpty: Boolean; 2070 | begin 2071 | if recurse then 2072 | begin 2073 | if FindFirst(p + '*.*', faDirectory, f) = 0 then 2074 | repeat 2075 | if (f.Name[1] <> '.') then 2076 | Traverse(IncludeTrailingPathDelimiter(p + f.Name)); 2077 | until FindNext(f) <> 0; 2078 | SysUtils.FindClose(f); 2079 | end; 2080 | 2081 | for i := 0 to willlist.Count - 1 do 2082 | begin 2083 | IsEmpty := True; 2084 | if FindFirst(p + willlist[i], faReadOnly or faHidden or faSysFile or faArchive, f) = 0 then 2085 | repeat 2086 | IsEmpty := False; 2087 | item := T7zBatchItem.Create; 2088 | Item.SourceMode := smFile; 2089 | item.Stream := nil; 2090 | item.FileName := p + f.Name; 2091 | item.Path := copy(item.FileName, lencut, length(item.FileName) - lencut + 1); 2092 | if path <> '' then 2093 | item.Path := IncludeTrailingPathDelimiter(path) + item.Path; 2094 | item.CreationTime := f.FindData.ftCreationTime; 2095 | item.LastWriteTime := f.FindData.ftLastWriteTime; 2096 | item.Attributes := f.FindData.dwFileAttributes; 2097 | item.Size := f.Size; 2098 | item.IsFolder := false; 2099 | item.IsAnti := False; 2100 | item.Ownership := soOwned; 2101 | FBatchList.Add(item); 2102 | until FindNext(f) <> 0; 2103 | SysUtils.FindClose(f); 2104 | if IncludeEmptyDir and IsEmpty and (not FileExists(p)) and DirectoryExists(p) then 2105 | begin 2106 | item := T7zBatchItem.Create; 2107 | Item.SourceMode := smFile; 2108 | item.Stream := nil; 2109 | item.FileName := p; 2110 | item.Path := copy(item.FileName, lencut, length(item.FileName) - lencut + 1); 2111 | if path <> '' then 2112 | item.Path := IncludeTrailingPathDelimiter(path) + item.Path; 2113 | item.CreationTime := f.FindData.ftCreationTime; 2114 | item.LastWriteTime := f.FindData.ftLastWriteTime; 2115 | item.Attributes := f.FindData.dwFileAttributes; 2116 | item.Size := f.Size; 2117 | item.IsFolder := True; 2118 | item.IsAnti := False; 2119 | item.Ownership := soOwned; 2120 | FBatchList.Add(item); 2121 | end; 2122 | end; 2123 | end; 2124 | begin 2125 | willlist := TStringList.Create; 2126 | try 2127 | willlist.Delimiter := ';'; 2128 | willlist.DelimitedText := Wildcard; 2129 | zedir := IncludeTrailingPathDelimiter(Dir); 2130 | lencut := Length(zedir) + 1; 2131 | Traverse(zedir); 2132 | finally 2133 | willlist.Free; 2134 | end; 2135 | end; 2136 | 2137 | procedure T7zOutArchive.AddStream(Stream: TStream; Ownership: TStreamOwnership; 2138 | Attributes: Cardinal; CreationTime, LastWriteTime: TFileTime; 2139 | const Path: UnicodeString; IsFolder, IsAnti: boolean); stdcall; 2140 | var 2141 | item: T7zBatchItem; 2142 | begin 2143 | item := T7zBatchItem.Create; 2144 | Item.SourceMode := smStream; 2145 | item.Attributes := Attributes; 2146 | item.CreationTime := CreationTime; 2147 | item.LastWriteTime := LastWriteTime; 2148 | item.Path := Path; 2149 | item.IsFolder := IsFolder; 2150 | item.IsAnti := IsAnti; 2151 | item.Stream := Stream; 2152 | item.Size := Stream.Size; 2153 | item.Ownership := Ownership; 2154 | FBatchList.Add(item); 2155 | end; 2156 | 2157 | procedure T7zOutArchive.ClearBatch; 2158 | begin 2159 | FBatchList.Clear; 2160 | end; 2161 | 2162 | constructor T7zOutArchive.Create(const lib: string); 2163 | begin 2164 | inherited; 2165 | FBatchList := TObjectList.Create; 2166 | FProgressCallback := nil; 2167 | FProgressSender := nil; 2168 | end; 2169 | 2170 | function T7zOutArchive.CryptoGetTextPassword2(passwordIsDefined: PInteger; 2171 | var password: TBStr): HRESULT; 2172 | begin 2173 | if FPassword <> '' then 2174 | begin 2175 | passwordIsDefined^ := 1; 2176 | password := SysAllocString(PWideChar(FPassword)); 2177 | end else 2178 | passwordIsDefined^ := 0; 2179 | Result := S_OK; 2180 | end; 2181 | 2182 | destructor T7zOutArchive.Destroy; 2183 | begin 2184 | FOutArchive := nil; 2185 | FBatchList.Free; 2186 | inherited; 2187 | end; 2188 | 2189 | function T7zOutArchive.GetOutArchive: IOutArchive; 2190 | begin 2191 | if FOutArchive = nil then 2192 | CreateObject(ClassID, IOutArchive, FOutArchive); 2193 | Result := FOutArchive; 2194 | end; 2195 | 2196 | function T7zOutArchive.GetProperty(index: Cardinal; propID: PROPID; 2197 | var value: OleVariant): HRESULT; 2198 | var 2199 | item: T7zBatchItem; 2200 | begin 2201 | item := T7zBatchItem(FBatchList[index]); 2202 | case propID of 2203 | kpidAttrib: 2204 | begin 2205 | TPropVariant(Value).vt := VT_UI4; 2206 | TPropVariant(Value).ulVal := item.Attributes; 2207 | end; 2208 | kpidMTime: 2209 | begin 2210 | TPropVariant(value).vt := VT_FILETIME; 2211 | TPropVariant(value).filetime := item.LastWriteTime; 2212 | end; 2213 | kpidPath: 2214 | begin 2215 | if item.Path <> '' then 2216 | value := item.Path; 2217 | end; 2218 | kpidIsDir: Value := item.IsFolder; 2219 | kpidSize: 2220 | begin 2221 | TPropVariant(Value).vt := VT_UI8; 2222 | TPropVariant(Value).uhVal.QuadPart := item.Size; 2223 | end; 2224 | kpidCTime: 2225 | begin 2226 | TPropVariant(value).vt := VT_FILETIME; 2227 | TPropVariant(value).filetime := item.CreationTime; 2228 | end; 2229 | //add by flying wang. 2230 | kpidATime: 2231 | begin 2232 | TPropVariant(value).vt := VT_FILETIME; 2233 | TPropVariant(value).filetime := item.LastWriteTime; 2234 | end; 2235 | kpidTimeType: 2236 | begin 2237 | TPropVariant(value).vt := VT_UI4; 2238 | {$IFDEF MSWINDOWS} 2239 | TPropVariant(value).ulVal := Integer(kWindows); 2240 | {$ELSE MSWINDOWS} 2241 | TPropVariant(value).ulVal := Integer(kUnix); 2242 | {$ENDIF MSWINDOWS} 2243 | end; 2244 | kpidIsAnti: value := item.IsAnti; 2245 | else 2246 | // beep(0,0); 2247 | end; 2248 | Result := S_OK; 2249 | end; 2250 | 2251 | function T7zOutArchive.GetStream(index: Cardinal; 2252 | var inStream: ISequentialInStream): HRESULT; 2253 | var 2254 | item: T7zBatchItem; 2255 | begin 2256 | item := T7zBatchItem(FBatchList[index]); 2257 | case item.SourceMode of 2258 | smFile: inStream := T7zStream.Create(TFileStream.Create(item.FileName, fmOpenRead or fmShareDenyNone), soOwned); 2259 | smStream: 2260 | begin 2261 | item.Stream.Seek(0, soFromBeginning); 2262 | inStream := T7zStream.Create(item.Stream); 2263 | end; 2264 | end; 2265 | Result := S_OK; 2266 | end; 2267 | 2268 | function T7zOutArchive.GetUpdateItemInfo(index: Cardinal; newData, 2269 | newProperties: PInteger; indexInArchive: PCardinal): HRESULT; 2270 | begin 2271 | newData^ := 1; 2272 | newProperties^ := 1; 2273 | indexInArchive^ := CArdinal(-1); 2274 | Result := S_OK; 2275 | end; 2276 | 2277 | procedure T7zOutArchive.SaveToFile(const FileName: TFileName); 2278 | var 2279 | f: TFileStream; 2280 | begin 2281 | f := TFileStream.Create(FileName, fmCreate); 2282 | try 2283 | SaveToStream(f); 2284 | finally 2285 | f.free; 2286 | end; 2287 | end; 2288 | 2289 | procedure T7zOutArchive.SaveToStream(stream: TStream); 2290 | var 2291 | strm: ISequentialOutStream; 2292 | begin 2293 | strm := T7zStream.Create(stream); 2294 | try 2295 | RINOK(OutArchive.UpdateItems(strm, FBatchList.Count, self as IArchiveUpdateCallback)); 2296 | finally 2297 | strm := nil; 2298 | end; 2299 | end; 2300 | 2301 | function T7zOutArchive.SetCompleted(completeValue: PInt64): HRESULT; 2302 | begin 2303 | //fix by flying wang. 2304 | Result := kCallBackError; 2305 | if Assigned(FProgressCallback) and (completeValue <> nil) then 2306 | Result := FProgressCallback(FProgressSender, false, completeValue^) else 2307 | Result := S_OK; 2308 | end; 2309 | 2310 | function T7zOutArchive.SetOperationResult( 2311 | operationResult: Integer): HRESULT; 2312 | begin 2313 | Result := S_OK; 2314 | end; 2315 | 2316 | procedure T7zOutArchive.SetPassword(const password: UnicodeString); 2317 | begin 2318 | FPassword := password; 2319 | end; 2320 | 2321 | procedure T7zOutArchive.SetProgressCallback(sender: Pointer; 2322 | callback: T7zProgressCallback); 2323 | begin 2324 | FProgressCallback := callback; 2325 | FProgressSender := sender; 2326 | end; 2327 | 2328 | procedure T7zOutArchive.SetPropertie(name: UnicodeString; 2329 | value: OleVariant); 2330 | var 2331 | intf: ISetProperties; 2332 | p: PWideChar; 2333 | begin 2334 | intf := OutArchive as ISetProperties; 2335 | p := PWideChar(name); 2336 | RINOK(intf.SetProperties(@p, @TPropVariant(value), 1)); 2337 | end; 2338 | 2339 | function T7zOutArchive.SetTotal(total: Int64): HRESULT; 2340 | begin 2341 | //fix by flying wang. 2342 | Result := kCallBackError; 2343 | if Assigned(FProgressCallback) then 2344 | Result := FProgressCallback(FProgressSender, true, total) else 2345 | Result := S_OK; 2346 | end; 2347 | 2348 | initialization 2349 | G_7zWorkPath := ''; 2350 | 2351 | //finalization 2352 | 2353 | 2354 | end. 2355 | --------------------------------------------------------------------------------