客服电话
APP下载
迪恩网络APP
随时随地掌握行业动态
官方微信
扫描二维码
关注迪恩网络微信公众号
|
续上章 sevenzip.pas 源码
(* ****************************************************************************** *) (* 7-ZIP DELPHI API *) (* *) (* The contents of this file are subject to the Mozilla Public License Version *) (* 1.1 (the "License"); you may not use this file except in compliance with the *) (* License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ *) (* *) (* Software distributed under the License is distributed on an "AS IS" basis, *) (* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *) (* the specific language governing rights and limitations under the License. *) (* *) (* Unit owner : Henri Gourvest <<a href="mailto:[email protected]">[email protected]</a>> *) (* V1.2 *) (* ****************************************************************************** *) unit sevenzip; {$ALIGN ON} {$MINENUMSIZE 4} {$WARN SYMBOL_PLATFORM OFF} interface uses SysUtils, Windows, ActiveX, Classes, Contnrs; type PVarType = ^TVarType; PCardArray = ^TCardArray; TCardArray = array [0 .. MaxInt div SizeOf(Cardinal) - 1] of Cardinal; {$IFNDEF UNICODE} UnicodeString = WideString; {$ENDIF} // ****************************************************************************** // PropID.h // ****************************************************************************** const kpidNoProperty = 0; kpidHandlerItemIndex = 2; kpidPath = 3; // VT_BSTR kpidName = 4; // VT_BSTR kpidExtension = 5; // VT_BSTR kpidIsFolder = 6; // VT_BOOL kpidSize = 7; // VT_UI8 kpidPackedSize = 8; // VT_UI8 kpidAttributes = 9; // VT_UI4 kpidCreationTime = 10; // VT_FILETIME kpidLastAccessTime = 11; // VT_FILETIME kpidLastWriteTime = 12; // VT_FILETIME kpidSolid = 13; // VT_BOOL kpidCommented = 14; // VT_BOOL kpidEncrypted = 15; // VT_BOOL kpidSplitBefore = 16; // VT_BOOL kpidSplitAfter = 17; // VT_BOOL kpidDictionarySize = 18; // VT_UI4 kpidCRC = 19; // VT_UI4 kpidType = 20; // VT_BSTR kpidIsAnti = 21; // VT_BOOL kpidMethod = 22; // VT_BSTR kpidHostOS = 23; // VT_BSTR kpidFileSystem = 24; // VT_BSTR kpidUser = 25; // VT_BSTR kpidGroup = 26; // VT_BSTR kpidBlock = 27; // VT_UI4 kpidComment = 28; // VT_BSTR kpidPosition = 29; // VT_UI4 kpidPrefix = 30; // VT_BSTR kpidNumSubDirs = 31; // VT_UI4 kpidNumSubFiles = 32; // VT_UI4 kpidUnpackVer = 33; // VT_UI1 kpidVolume = 34; // VT_UI4 kpidIsVolume = 35; // VT_BOOL kpidOffset = 36; // VT_UI8 kpidLinks = 37; // VT_UI4 kpidNumBlocks = 38; // VT_UI4 kpidNumVolumes = 39; // VT_UI4 kpidTimeType = 40; // VT_UI4 kpidBit64 = 41; // VT_BOOL kpidBigEndian = 42; // VT_BOOL kpidCpu = 43; // VT_BSTR kpidPhySize = 44; // VT_UI8 kpidHeadersSize = 45; // VT_UI8 kpidChecksum = 46; // VT_UI4 kpidCharacts = 47; // VT_BSTR kpidVa = 48; // VT_UI8 kpidTotalSize = $1100; // VT_UI8 kpidFreeSpace = kpidTotalSize + 1; // VT_UI8 kpidClusterSize = kpidFreeSpace + 1; // VT_UI8 kpidVolumeName = kpidClusterSize + 1; // VT_BSTR kpidLocalName = $1200; // VT_BSTR kpidProvider = kpidLocalName + 1; // VT_BSTR kpidUserDefined = $10000; // ****************************************************************************** // IProgress.h // ****************************************************************************** type IProgress = interface(IUnknown) ['{23170F69-40C1-278A-0000-000000050000}'] function SetTotal(total: Int64): HRESULT; stdcall; function SetCompleted(completeValue: PInt64): HRESULT; stdcall; end; // ****************************************************************************** // IPassword.h // ****************************************************************************** ICryptoGetTextPassword = interface(IUnknown) ['{23170F69-40C1-278A-0000-000500100000}'] function CryptoGetTextPassword(var password: TBStr): HRESULT; stdcall; end; ICryptoGetTextPassword2 = interface(IUnknown) ['{23170F69-40C1-278A-0000-000500110000}'] function CryptoGetTextPassword2(passwordIsDefined: PInteger; var password: TBStr): HRESULT; stdcall; end; // ****************************************************************************** // IStream.h // "23170F69-40C1-278A-0000-000300xx0000" // ****************************************************************************** ISequentialInStream = interface(IUnknown) ['{23170F69-40C1-278A-0000-000300010000}'] function Read(data: Pointer; size: Cardinal; processedSize: PCardinal) : HRESULT; stdcall; (* Out: if size != 0, return_value = S_OK and (*processedSize == 0), then there are no more bytes in stream. if (size > 0) && there are bytes in stream, this function must read at least 1 byte. This function is allowed to read less than number of remaining bytes in stream. You must call Read function in loop, if you need exact amount of data *) end; ISequentialOutStream = interface(IUnknown) ['{23170F69-40C1-278A-0000-000300020000}'] function Write(data: Pointer; size: Cardinal; processedSize: PCardinal) : HRESULT; stdcall; (* if (size > 0) this function must write at least 1 byte. This function is allowed to write less than "size". You must call Write function in loop, if you need to write exact amount of data *) end; IInStream = interface(ISequentialInStream) ['{23170F69-40C1-278A-0000-000300030000}'] function Seek(offset: Int64; seekOrigin: Cardinal; newPosition: PInt64) : HRESULT; stdcall; end; IOutStream = interface(ISequentialOutStream) ['{23170F69-40C1-278A-0000-000300040000}'] function Seek(offset: Int64; seekOrigin: Cardinal; newPosition: PInt64) : HRESULT; stdcall; function SetSize(newSize: Int64): HRESULT; stdcall; end; IStreamGetSize = interface(IUnknown) ['{23170F69-40C1-278A-0000-000300060000}'] function GetSize(size: PInt64): HRESULT; stdcall; end; IOutStreamFlush = interface(IUnknown) ['{23170F69-40C1-278A-0000-000300070000}'] function Flush: HRESULT; stdcall; end; // ****************************************************************************** // IArchive.h // ****************************************************************************** // MIDL_INTERFACE("23170F69-40C1-278A-0000-000600xx0000") // #define ARCHIVE_INTERFACE_SUB(i, base, x) \ // DEFINE_GUID(IID_ ## i, \ // 0x23170F69, 0x40C1, 0x278A, 0x00, 0x00, 0x00, 0x06, 0x00, x, 0x00, 0x00); \ // struct i: public base // #define ARCHIVE_INTERFACE(i, x) ARCHIVE_INTERFACE_SUB(i, IUnknown, x) type // NFileTimeType NFileTimeType = (kWindows = 0, kUnix, kDOS); // NArchive:: NArchive = (kName = 0, // string kClassID, // GUID kExtension, // string zip rar gz kAddExtension, // sub archive: tar kUpdate, // bool kKeepName, // bool kStartSignature, // string[4] ex: PK.. 7z.. Rar! kFinishSignature, kAssociate); // NArchive::NExtract::NAskMode NAskMode = (kExtract = 0, kTest, kSkip); // NArchive::NExtract::NOperationResult NExtOperationResult = (kOK = 0, kUnSupportedMethod, kDataError, kCRCError); // NArchive::NUpdate::NOperationResult NUpdOperationResult = (kOK_ = 0, kError); IArchiveOpenCallback = interface ['{23170F69-40C1-278A-0000-000600100000}'] function SetTotal(files, bytes: PInt64): HRESULT; stdcall; function SetCompleted(files, bytes: PInt64): HRESULT; stdcall; end; IArchiveExtractCallback = interface(IProgress) ['{23170F69-40C1-278A-0000-000600200000}'] function GetStream(index: Cardinal; var outStream: ISequentialOutStream; askExtractMode: NAskMode): HRESULT; stdcall; // GetStream OUT: S_OK - OK, S_FALSE - skeep this file function PrepareOperation(askExtractMode: NAskMode): HRESULT; stdcall; function SetOperationResult(resultEOperationResult: NExtOperationResult) : HRESULT; stdcall; end; IArchiveOpenVolumeCallback = interface ['{23170F69-40C1-278A-0000-000600300000}'] function GetProperty(propID: propID; var value: OleVariant) : HRESULT; stdcall; function GetStream(const name: PWideChar; var inStream: IInStream) : HRESULT; stdcall; end; IInArchiveGetStream = interface ['{23170F69-40C1-278A-0000-000600400000}'] function GetStream(index: Cardinal; var stream: ISequentialInStream) : HRESULT; stdcall; end; IArchiveOpenSetSubArchiveName = interface ['{23170F69-40C1-278A-0000-000600500000}'] function SetSubArchiveName(name: PWideChar): HRESULT; stdcall; end; IInArchive = interface ['{23170F69-40C1-278A-0000-000600600000}'] function Open(stream: IInStream; const maxCheckStartPosition: PInt64; openArchiveCallback: IArchiveOpenCallback): HRESULT; stdcall; function Close: HRESULT; stdcall; function GetNumberOfItems(var numItems: Cardinal): HRESULT; stdcall; function GetProperty(index: Cardinal; propID: propID; var value: OleVariant) : HRESULT; stdcall; function Extract(indices: PCardArray; numItems: Cardinal; testMode: Integer; extractCallback: IArchiveExtractCallback): HRESULT; stdcall; // indices must be sorted // numItems = 0xFFFFFFFF means all files // testMode != 0 means "test files operation" function GetArchiveProperty(propID: propID; var value: OleVariant) : HRESULT; stdcall; function GetNumberOfProperties(numProperties: PCardinal): HRESULT; stdcall; function GetPropertyInfo(index: Cardinal; name: PBSTR; propID: PPropID; varType: PVarType): HRESULT; stdcall; function GetNumberOfArchiveProperties(var numProperties: Cardinal) : HRESULT; stdcall; function GetArchivePropertyInfo(index: Cardinal; name: PBSTR; propID: PPropID; varType: PVarType): HRESULT; stdcall; end; IArchiveUpdateCallback = interface(IProgress) ['{23170F69-40C1-278A-0000-000600800000}'] function GetUpdateItemInfo(index: Cardinal; newData: PInteger; // 1 - new data, 0 - old data newProperties: PInteger; // 1 - new properties, 0 - old properties indexInArchive: PCardinal // -1 if there is no in archive, or if doesn't matter ): HRESULT; stdcall; function GetProperty(index: Cardinal; propID: propID; var value: OleVariant) : HRESULT; stdcall; function GetStream(index: Cardinal; var inStream: ISequentialInStream) : HRESULT; stdcall; function SetOperationResult(operationResult: Integer): HRESULT; stdcall; end; IArchiveUpdateCallback2 = interface(IArchiveUpdateCallback) ['{23170F69-40C1-278A-0000-000600820000}'] function GetVolumeSize(index: Cardinal; size: PInt64): HRESULT; stdcall; function GetVolumeStream(index: Cardinal; var volumeStream: ISequentialOutStream): HRESULT; stdcall; end; IOutArchive = interface ['{23170F69-40C1-278A-0000-000600A00000}'] function UpdateItems(outStream: ISequentialOutStream; numItems: Cardinal; updateCallback: IArchiveUpdateCallback): HRESULT; stdcall; function GetFileTimeType(type_: PCardinal): HRESULT; stdcall; end; ISetProperties = interface ['{23170F69-40C1-278A-0000-000600030000}'] function SetProperties(names: PPWideChar; values: PPROPVARIANT; numProperties: Integer): HRESULT; stdcall; end; // ****************************************************************************** // ICoder.h // "23170F69-40C1-278A-0000-000400xx0000" // ****************************************************************************** ICompressProgressInfo = interface ['{23170F69-40C1-278A-0000-000400040000}'] function SetRatioInfo(inSize, outSize: PInt64): HRESULT; stdcall; end; ICompressCoder = interface ['{23170F69-40C1-278A-0000-000400050000}'] function Code(inStream, outStream: ISequentialInStream; inSize, outSize: PInt64; progress: ICompressProgressInfo) : HRESULT; stdcall; end; ICompressCoder2 = interface ['{23170F69-40C1-278A-0000-000400180000}'] function Code(var inStreams: ISequentialInStream; var inSizes: PInt64; numInStreams: Cardinal; var outStreams: ISequentialOutStream; var outSizes: PInt64; numOutStreams: Cardinal; progress: ICompressProgressInfo): HRESULT; stdcall; end; const // NCoderPropID:: kDictionarySize = $400; kUsedMemorySize = kDictionarySize + 1; kOrder = kUsedMemorySize + 1; kPosStateBits = $440; kLitContextBits = kPosStateBits + 1; kLitPosBits = kLitContextBits + 1; kNumFastBytes = $450; kMatchFinder = kNumFastBytes + 1; kMatchFinderCycles = kMatchFinder + 1; kNumPasses = $460; kAlgorithm = $470; kMultiThread = $480; kNumThreads = kMultiThread + 1; kEndMarker = $490; type ICompressSetCoderProperties = interface ['{23170F69-40C1-278A-0000-000400200000}'] function SetCoderProperties(propIDs: PPropID; properties: PROPVARIANT; numProperties: Cardinal): HRESULT; stdcall; end; (* CODER_INTERFACE(ICompressSetCoderProperties, 0x21) { STDMETHOD(SetDecoderProperties)(ISequentialInStream *inStream) PURE; }; *) ICompressSetDecoderProperties2 = interface ['{23170F69-40C1-278A-0000-000400220000}'] function SetDecoderProperties2(data: PByte; size: Cardinal) : HRESULT; stdcall; end; ICompressWriteCoderProperties = interface ['{23170F69-40C1-278A-0000-000400230000}'] function WriteCoderProperties(outStreams: ISequentialOutStream) : HRESULT; stdcall; end; ICompressGetInStreamProcessedSize = interface ['{23170F69-40C1-278A-0000-000400240000}'] function GetInStreamProcessedSize(value: PInt64): HRESULT; stdcall; end; ICompressSetCoderMt = interface ['{23170F69-40C1-278A-0000-000400250000}'] function SetNumberOfThreads(numThreads: Cardinal): HRESULT; stdcall; end; ICompressGetSubStreamSize = interface ['{23170F69-40C1-278A-0000-000400300000}'] function GetSubStreamSize(subStream: Int64; value: PInt64) : HRESULT; stdcall; end; ICompressSetInStream = interface ['{23170F69-40C1-278A-0000-000400310000}'] function SetInStream(inStream: ISequentialInStream): HRESULT; stdcall; function ReleaseInStream: HRESULT; stdcall; end; ICompressSetOutStream = interface ['{23170F69-40C1-278A-0000-000400320000}'] function SetOutStream(outStream: ISequentialOutStream): HRESULT; stdcall; function ReleaseOutStream: HRESULT; stdcall; end; ICompressSetInStreamSize = interface ['{23170F69-40C1-278A-0000-000400330000}'] function SetInStreamSize(inSize: PInt64): HRESULT; stdcall; end; ICompressSetOutStreamSize = interface ['{23170F69-40C1-278A-0000-000400340000}'] function SetOutStreamSize(outSize: PInt64): HRESULT; stdcall; end; ICompressFilter = interface ['{23170F69-40C1-278A-0000-000400400000}'] function Init: HRESULT; stdcall; function Filter(data: PByte; size: Cardinal): Cardinal; stdcall; // Filter return outSize (Cardinal) // if (outSize <= size): Filter have converted outSize bytes // if (outSize > size): Filter have not converted anything. // and it needs at least outSize bytes to convert one block // (it's for crypto block algorithms). end; ICryptoProperties = interface ['{23170F69-40C1-278A-0000-000400800000}'] function SetKey(data: PByte; size: Cardinal): HRESULT; stdcall; function SetInitVector(data: PByte; size: Cardinal): HRESULT; stdcall; end; ICryptoSetPassword = interface ['{23170F69-40C1-278A-0000-000400900000}'] function CryptoSetPassword(data: PByte; size: Cardinal): HRESULT; stdcall; end; ICryptoSetCRC = interface ['{23170F69-40C1-278A-0000-000400A00000}'] function CryptoSetCRC(crc: Cardinal): HRESULT; stdcall; end; /// /////////////////// // It's for DLL file // NMethodPropID:: NMethodPropID = (kID = 0, kName_, kDecoder, kEncoder, kInStreams, kOutStreams, kDescription, kDecoderIsAssigned, kEncoderIsAssigned); // ****************************************************************************** // CLASSES // ****************************************************************************** T7zPasswordCallback = function(sender: Pointer; var password: UnicodeString) : HRESULT; stdcall; T7zGetStreamCallBack = function(sender: Pointer; index: Cardinal; var outStream: ISequentialOutStream): HRESULT; stdcall; T7zProgressCallback = function(sender: Pointer; total: boolean; value: Int64) : HRESULT; stdcall; I7zInArchive = interface ['{022CF785-3ECE-46EF-9755-291FA84CC6C9}'] procedure OpenFile(const filename: string); stdcall; procedure OpenStream(stream: IInStream); stdcall; procedure Close; stdcall; function GetNumberOfItems: Cardinal; stdcall; function GetItemPath(const index: Integer): UnicodeString; stdcall; function GetItemName(const index: Integer): UnicodeString; stdcall; function GetItemSize(const index: Integer): Cardinal; stdcall; function GetItemIsFolder(const index: Integer): boolean; stdcall; function GetInArchive: IInArchive; procedure ExtractItem(const item: Cardinal; stream: TStream; test: longbool); stdcall; procedure ExtractItems(items: PCardArray; count: Cardinal; test: longbool; sender: Pointer; callback: T7zGetStreamCallBack); stdcall; procedure ExtractAll(test: longbool; sender: Pointer; callback: T7zGetStreamCallBack); stdcall; procedure ExtractTo(const path: string); stdcall; procedure SetPasswordCallback(sender: Pointer; callback: T7zPasswordCallback); stdcall; procedure SetPassword(const password: UnicodeString); stdcall; procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall; procedure SetClassId(const classid: TGUID); function GetClassId: TGUID; property classid: TGUID read GetClassId write SetClassId; property NumberOfItems: Cardinal read GetNumberOfItems; property ItemPath[const index: Integer]: UnicodeString read GetItemPath; property ItemName[const index: Integer]: UnicodeString read GetItemName; property ItemSize[const index: Integer]: Cardinal read GetItemSize; property ItemIsFolder[const index: Integer]: boolean read GetItemIsFolder; property InArchive: IInArchive read GetInArchive; end; I7zOutArchive = interface ['{BAA9D5DC-9FF4-4382-9BFD-EC9065BD0125}'] procedure AddStream(stream: TStream; Ownership: TStreamOwnership; Attributes: Cardinal; CreationTime, LastWriteTime: TFileTime; const path: UnicodeString; IsFolder, IsAnti: boolean); stdcall; procedure AddFile(const filename: TFileName; const path: UnicodeString); stdcall; procedure AddFiles(const Dir, path, Willcards: string; recurse: boolean); stdcall; procedure SaveToFile(const filename: TFileName); stdcall; procedure SaveToStream(stream: TStream); stdcall; procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall; procedure CrearBatch; stdcall; procedure SetPassword(const password: UnicodeString); stdcall; procedure SetPropertie(name: UnicodeString; value: OleVariant); stdcall; procedure SetClassId(const classid: TGUID); function GetClassId: TGUID; property classid: TGUID read GetClassId write SetClassId; end; I7zCodec = interface ['{AB48F772-F6B1-411E-907F-1567DB0E93B3}'] end; T7zStream = class(TInterfacedObject, IInStream, IStreamGetSize, ISequentialOutStream, ISequentialInStream, IOutStream, IOutStreamFlush) private FStream: TStream; FOwnership: TStreamOwnership; protected function Read(data: Pointer; size: Cardinal; processedSize: PCardinal) : HRESULT; stdcall; function Seek(offset: Int64; seekOrigin: Cardinal; newPosition: PInt64) : HRESULT; stdcall; function GetSize(size: PInt64): HRESULT; stdcall; function SetSize(newSize: Int64): HRESULT; stdcall; function Write(data: Pointer; size: Cardinal; processedSize: PCardinal) : HRESULT; stdcall; function Flush: HRESULT; stdcall; public constructor Create(stream: TStream; Ownership: TStreamOwnership = soReference); destructor Destroy; override; end; // I7zOutArchive property setters type TZipCompressionMethod = (mzCopy, mzDeflate, mzDeflate64, mzBZip2); T7zCompressionMethod = (m7Copy, m7LZMA, m7BZip2, m7PPMd, m7Deflate, m7Deflate64); // ZIP 7z GZIP BZ2 procedure SetCompressionLevel(Arch: I7zOutArchive; level: Cardinal); // X X X X procedure SetMultiThreading(Arch: I7zOutArchive; ThreadCount: Cardinal); // X X X procedure SetCompressionMethod(Arch: I7zOutArchive; method: TZipCompressionMethod); // X procedure SetDictionnarySize(Arch: I7zOutArchive; size: Cardinal); // < 32 // X X procedure SetDeflateNumPasses(Arch: I7zOutArchive; pass: Cardinal); // X X X procedure SetNumFastBytes(Arch: I7zOutArchive; fb: Cardinal); // X X procedure SetNumMatchFinderCycles(Arch: I7zOutArchive; mc: Cardinal); // X X procedure SevenZipSetCompressionMethod(Arch: I7zOutArchive; method: T7zCompressionMethod); // X procedure SevenZipSetBindInfo(Arch: I7zOutArchive; const bind: UnicodeString); // X procedure SevenZipSetSolidSettings(Arch: I7zOutArchive; solid: boolean); // X procedure SevenZipRemoveSfxBlock(Arch: I7zOutArchive; remove: boolean); // X procedure SevenZipAutoFilter(Arch: I7zOutArchive; auto: boolean); // X procedure SevenZipCompressHeaders(Arch: I7zOutArchive; compress: boolean); // X procedure SevenZipCompressHeadersFull(Arch: I7zOutArchive; compress: boolean); // X procedure SevenZipEncryptHeaders(Arch: I7zOutArchive; Encrypt: boolean); // X procedure SevenZipVolumeMode(Arch: I7zOutArchive; Mode: boolean); // X // filetime util functions function DateTimeToFileTime(dt: TDateTime): TFileTime; function FileTimeToDateTime(ft: TFileTime): TDateTime; function CurrentFileTime: TFileTime; // constructors function CreateInArchive(const classid: TGUID): I7zInArchive; overload; function CreateInArchive(const filename: WideString): I7zInArchive;overload; function CreateOutArchive(const classid: TGUID): I7zOutArchive; const CLSID_CFormatZip: TGUID = '{23170F69-40C1-278A-1000-000110010000}'; // zip jar xpi CLSID_CFormatBZ2: TGUID = '{23170F69-40C1-278A-1000-000110020000}'; // bz2 bzip2 tbz2 tbz CLSID_CFormatRar: TGUID = '{23170F69-40C1-278A-1000-000110030000}'; // rar r00 CLSID_CFormatArj: TGUID = '{23170F69-40C1-278A-1000-000110040000}'; // arj CLSID_CFormatZ: TGUID = '{23170F69-40C1-278A-1000-000110050000}'; // z taz CLSID_CFormatLzh: TGUID = '{23170F69-40C1-278A-1000-000110060000}'; // lzh lha CLSID_CFormat7z: TGUID = '{23170F69-40C1-278A-1000-000110070000}'; // 7z CLSID_CFormatCab: TGUID = '{23170F69-40C1-278A-1000-000110080000}'; // cab CLSID_CFormatNsis: TGUID = '{23170F69-40C1-278A-1000-000110090000}'; CLSID_CFormatLzma: TGUID = '{23170F69-40C1-278A-1000-0001100A0000}'; // lzma lzma86 CLSID_CFormatPe: TGUID = '{23170F69-40C1-278A-1000-000110DD0000}'; CLSID_CFormatElf: TGUID = '{23170F69-40C1-278A-1000-000110DE0000}'; CLSID_CFormatMacho: TGUID = '{23170F69-40C1-278A-1000-000110DF0000}'; CLSID_CFormatUdf: TGUID = '{23170F69-40C1-278A-1000-000110E00000}'; // iso CLSID_CFormatXar: TGUID = '{23170F69-40C1-278A-1000-000110E10000}'; // xar CLSID_CFormatMub: TGUID = '{23170F69-40C1-278A-1000-000110E20000}'; CLSID_CFormatHfs: TGUID = '{23170F69-40C1-278A-1000-000110E30000}'; CLSID_CFormatDmg: TGUID = '{23170F69-40C1-278A-1000-000110E40000}'; // dmg CLSID_CFormatCompound: TGUID = '{23170F69-40C1-278A-1000-000110E50000}'; // msi doc xls ppt CLSID_CFormatWim: TGUID = '{23170F69-40C1-278A-1000-000110E60000}'; // wim swm CLSID_CFormatIso: TGUID = '{23170F69-40C1-278A-1000-000110E70000}'; // iso CLSID_CFormatBkf: TGUID = '{23170F69-40C1-278A-1000-000110E80000}'; CLSID_CFormatChm: TGUID = '{23170F69-40C1-278A-1000-000110E90000}'; // chm chi chq chw hxs hxi hxr hxq hxw lit CLSID_CFormatSplit: TGUID = '{23170F69-40C1-278A-1000-000110EA0000}'; // 001 CLSID_CFormatRpm: TGUID = '{23170F69-40C1-278A-1000-000110EB0000}'; // rpm CLSID_CFormatDeb: TGUID = '{23170F69-40C1-278A-1000-000110EC0000}'; // deb CLSID_CFormatCpio: TGUID = '{23170F69-40C1-278A-1000-000110ED0000}'; // cpio CLSID_CFormatTar: TGUID = '{23170F69-40C1-278A-1000-000110EE0000}'; // tar CLSID_CFormatGZip: TGUID = '{23170F69-40C1-278A-1000-000110EF0000}'; // gz gzip tgz tpz implementation const MAXCHECK: Int64 = (1 shl 20); ZipCompressionMethod: array [TZipCompressionMethod] of UnicodeString = ('COPY', 'DEFLATE', 'DEFLATE64', 'BZIP2'); SevCompressionMethod: array [T7zCompressionMethod] of UnicodeString = ('COPY', 'LZMA', 'BZIP2', 'PPMD', 'DEFLATE', 'DEFLATE64'); function DateTimeToFileTime(dt: TDateTime): TFileTime; var st: TSystemTime; begin DateTimeToSystemTime(dt, st); if not(SystemTimeToFileTime(st, Result) and LocalFileTimeToFileTime(Result, Result)) then RaiseLastOSError; end; function FileTimeToDateTime(ft: TFileTime): TDateTime; var st: TSystemTime; begin if not(FileTimeToLocalFileTime(ft, ft) and FileTimeToSystemTime(ft, st)) then RaiseLastOSError; Result := SystemTimeToDateTime(st); end; function CurrentFileTime: TFileTime; begin GetSystemTimeAsFileTime(Result); end; procedure RINOK(const hr: HRESULT); begin if hr <> S_OK then raise Exception.Create(SysErrorMessage(hr)); end; procedure SetCardinalProperty(Arch: I7zOutArchive; const name: UnicodeString; card: Cardinal); var value: OleVariant; begin TPropVariant(value).vt := VT_UI4; TPropVariant(value).ulVal := card; Arch.SetPropertie(name, value); end; procedure SetBooleanProperty(Arch: I7zOutArchive; const name: UnicodeString; bool: boolean); begin case bool of true: Arch.SetPropertie(name, 'ON'); false: Arch.SetPropertie(name, 'OFF'); end; end; procedure SetCompressionLevel(Arch: I7zOutArchive; level: Cardinal); begin SetCardinalProperty(Arch, 'X', level); end; procedure SetMultiThreading(Arch: I7zOutArchive; ThreadCount: Cardinal); begin SetCardinalProperty(Arch, 'MT', ThreadCount); end; procedure SetCompressionMethod(Arch: I7zOutArchive; method: TZipCompressionMethod); begin Arch.SetPropertie('M', ZipCompressionMethod[method]); end; procedure SetDictionnarySize(Arch: I7zOutArchive; size: Cardinal); begin SetCardinalProperty(Arch, 'D', size); end; procedure SetDeflateNumPasses(Arch: I7zOutArchive; pass: Cardinal); begin SetCardinalProperty(Arch, 'PASS', pass); end; procedure SetNumFastBytes(Arch: I7zOutArchive; fb: Cardinal); begin SetCardinalProperty(Arch, 'FB', fb); end; procedure SetNumMatchFinderCycles(Arch: I7zOutArchive; mc: Cardinal); begin SetCardinalProperty(Arch, 'MC', mc); end; procedure SevenZipSetCompressionMethod(Arch: I7zOutArchive; method: T7zCompressionMethod); begin Arch.SetPropertie('0', SevCompressionMethod[method]); end; procedure SevenZipSetBindInfo(Arch: I7zOutArchive; const bind: UnicodeString); begin Arch.SetPropertie('B', bind); end; procedure SevenZipSetSolidSettings(Arch: I7zOutArchive; solid: boolean); begin SetBooleanProperty(Arch, 'S', solid); end; procedure SevenZipRemoveSfxBlock(Arch: I7zOutArchive; remove: boolean); begin SetBooleanProperty(Arch, 'RSFX', remove); end; procedure SevenZipAutoFilter(Arch: I7zOutArchive; auto: boolean); begin SetBooleanProperty(Arch, 'F', auto); end; procedure SevenZipCompressHeaders(Arch: I7zOutArchive; compress: boolean); begin SetBooleanProperty(Arch, 'HC', compress); end; procedure SevenZipCompressHeadersFull(Arch: I7zOutArchive; compress: boolean); begin SetBooleanProperty(Arch, 'HCF', compress); end; procedure SevenZipEncryptHeaders(Arch: I7zOutArchive; Encrypt: boolean); begin SetBooleanProperty(Arch, 'HE', Encrypt); end; procedure SevenZipVolumeMode(Arch: I7zOutArchive; Mode: boolean); begin SetBooleanProperty(Arch, 'V', Mode); end; type T7zPlugin = class(TInterfacedObject) private FHandle: THandle; FCreateObject: function(const clsid, iid: TGUID; var outObject) : HRESULT; stdcall; public constructor Create(const lib: string); virtual; destructor Destroy; override; procedure CreateObject(const clsid, iid: TGUID; var obj); end; T7zCodec = class(T7zPlugin, I7zCodec, ICompressProgressInfo) private FGetMethodProperty: function(index: Cardinal; propID: NMethodPropID; var value: OleVariant): HRESULT; stdcall; FGetNumberOfMethods: function(numMethods: PCardinal): HRESULT; stdcall; function GetNumberOfMethods: Cardinal; function GetMethodProperty(index: Cardinal; propID: NMethodPropID) : OleVariant; function GetName(const index: Integer): string; protected function SetRatioInfo(inSize, outSize: PInt64): HRESULT; stdcall; public function GetDecoder(const index: Integer): ICompressCoder; function GetEncoder(const index: Integer): ICompressCoder; constructor Create(const lib: string); override; property MethodProperty[index: Cardinal; propID: NMethodPropID]: OleVariant read GetMethodProperty; property NumberOfMethods: Cardinal read GetNumberOfMethods; property Name[const index: Integer]: string read GetName; end; T7zArchive = class(T7zPlugin) private FGetHandlerProperty: function(propID: NArchive; var value: OleVariant) : HRESULT; stdcall; FClassId: TGUID; procedure SetClassId(const classid: TGUID); function GetClassId: TGUID; public function GetHandlerProperty(const propID: NArchive): OleVariant; function GetLibStringProperty(const index: NArchive): string; function GetLibGUIDProperty(const index: NArchive): TGUID; constructor Create(const lib: string); override; property HandlerProperty[const propID: NArchive]: OleVariant read GetHandlerProperty; property Name: string index kName read GetLibStringProperty; property classid: TGUID read GetClassId write SetClassId; property Extension: string index kExtension read GetLibStringProperty; end; T7zInArchive = class(T7zArchive, I7zInArchive, IProgress, IArchiveOpenCallback, IArchiveExtractCallback, ICryptoGetTextPassword, IArchiveOpenVolumeCallback, IArchiveOpenSetSubArchiveName) private FInArchive: IInArchive; FPasswordCallback: T7zPasswordCallback; FPasswordSender: Pointer; FProgressCallback: T7zProgressCallback; FProgressSender: Pointer; FStream: TStream; FPasswordIsDefined: boolean; FPassword: UnicodeString; FSubArchiveMode: boolean; FSubArchiveName: UnicodeString; FExtractCallBack: T7zGetStreamCallBack; FExtractSender: Pointer; FExtractPath: string; function GetInArchive: IInArchive; function GetItemProp(const item: Cardinal; prop: propID): OleVariant; protected // I7zInArchive procedure OpenFile(const filename: string); stdcall; procedure OpenStream(stream: IInStream); stdcall; procedure Close; stdcall; function GetNumberOfItems: Cardinal; stdcall; function GetItemPath(const index: Integer): UnicodeString; stdcall; function GetItemName(const index: Integer): UnicodeString; stdcall; function GetItemSize(const index: Integer): Cardinal; stdcall; stdcall; function GetItemIsFolder(const index: Integer): boolean; stdcall; procedure ExtractItem(const item: Cardinal; stream: TStream; test: longbool); stdcall; procedure ExtractItems(items: PCardArray; count: Cardinal; test: longbool; sender: Pointer; callback: T7zGetStreamCallBack); stdcall; procedure SetPasswordCallback(sender: Pointer; callback: T7zPasswordCallback); stdcall; procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall; procedure ExtractAll(test: longbool; sender: Pointer; callback: T7zGetStreamCallBack); stdcall; procedure ExtractTo(const path: string); stdcall; procedure SetPassword(const password: UnicodeString); stdcall; // IArchiveOpenCallback function SetTotal(files, bytes: PInt64): HRESULT; overload; stdcall; function SetCompleted(files, bytes: PInt64): HRESULT; overload; stdcall; // IProgress function SetTotal(total: Int64): HRESULT; overload; stdcall; function SetCompleted(completeValue: PInt64): HRESULT; overload; stdcall; // IArchiveExtractCallback function GetStream(index: Cardinal; var outStream: ISequentialOutStream; askExtractMode: NAskMode): HRESULT; overload; stdcall; function PrepareOperation(askExtractMode: NAskMode): HRESULT; stdcall; function SetOperationResult(resultEOperationResult: NExtOperationResult) : HRESULT; overload; stdcall; // ICryptoGetTextPassword function CryptoGetTextPassword(var password: TBStr): HRESULT; stdcall; // IArchiveOpenVolumeCallback function GetProperty(propID: propID; var value: OleVariant): HRESULT; overload; stdcall; function GetStream(const name: PWideChar; var inStream: IInStream): HRESULT; overload; stdcall; // IArchiveOpenSetSubArchiveName function SetSubArchiveName(name: PWideChar): HRESULT; stdcall; public constructor Create(const lib: string); override; destructor Destroy; override; property InArchive: IInArchive read GetInArchive; end; T7zOutArchive = class(T7zArchive, I7zOutArchive, IArchiveUpdateCallback, ICryptoGetTextPassword2) private FOutArchive: IOutArchive; FBatchList: TObjectList; FProgressCallback: T7zProgressCallback; FProgressSender: Pointer; FPassword: UnicodeString; function GetOutArchive: IOutArchive; protected // I7zOutArchive procedure AddStream(stream: TStream; Ownership: TStreamOwnership; Attributes: Cardinal; CreationTime, LastWriteTime: TFileTime; const path: UnicodeString; IsFolder, IsAnti: boolean); stdcall; procedure AddFile(const filename: TFileName; const path: UnicodeString); stdcall; procedure AddFiles(const Dir, path, Willcards: string; recurse: boolean); stdcall; procedure SaveToFile(const filename: TFileName); stdcall; procedure SaveToStream(stream: TStream); stdcall; procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall; procedure CrearBatch; stdcall; procedure SetPassword(const password: UnicodeString); stdcall; procedure SetPropertie(name: UnicodeString; value: OleVariant); stdcall; // IProgress function SetTotal(total: Int64): HRESULT; stdcall; function SetCompleted(completeValue: PInt64): HRESULT; stdcall; // IArchiveUpdateCallback function GetUpdateItemInfo(index: Cardinal; newData: PInteger; // 1 - new data, 0 - old data newProperties: PInteger; // 1 - new properties, 0 - old properties indexInArchive: PCardinal // -1 if there is no in archive, or if doesn't matter ): HRESULT; stdcall; function GetProperty(index: Cardinal; propID: propID; var value: OleVariant) : HRESULT; stdcall; function GetStream(index: Cardinal; var inStream: ISequentialInStream) : HRESULT; stdcall; function SetOperationResult(operationResult: Integer): HRESULT; stdcall; // ICryptoGetTextPassword2 function CryptoGetTextPassword2(passwordIsDefined: PInteger; var password: TBStr): HRESULT; stdcall; public constructor Create(const lib: string); override; destructor Destroy; override; property OutArchive: IOutArchive read GetOutArchive; end; function CreateInArchive(const classid: TGUID): I7zInArchive; begin Result := T7zInArchive.Create('7z.dll'); Result.classid := classid; end; function CreateInArchive(const filename: WideString): I7zInArchive; var sExt: WideString; begin Result := T7zInArchive.Create('7z.dll'); sExt := UpperCase(ExtractFileExt(filename)); if (sExt='.ZIP') or (sExt='.JAR') or (sExt='.XPI') then Result.classid := CLSID_CFormatZip else if (sExt='.BZ2') or (sExt='.BZIP2') or (sExt='.TBZ2') or (sExt='.TBZ') then Result.classid := CLSID_CFormatBZ2 else if (sExt='.RAR') or (sExt='.R00') then Result.classid := CLSID_CFormatRar else if (sExt='.ARJ') then Result.classid := CLSID_CFormatArj else if (sExt='.Z') or (sExt='.TAZ') then Result.classid := CLSID_CFormatZ else if (sExt='.LZH') or (sExt='.LHA') then Result.classid := CLSID_CFormatLzh else if (sExt='.7Z') then Result.classid := CLSID_CFormat7z else if (sExt='.CAB') then Result.classid := CLSID_CFormatCab else if (sExt='.NSIS') then Result.classid := CLSID_CFormatNsis else if (sExt='.LZMA') or (sExt='.LZMA86') then Result.classid := CLSID_CFormatLzma else if (sExt='.PE') or (sExt='.EXE') or (sExt='.DLL') or (sExt='.SYS') then Result.classid := CLSID_CFormatPe else if (sExt='.ELF') then Result.classid := CLSID_CFormatElf else if (sExt='.MACHO') then Result.classid := CLSID_CFormatMacho else if {(sExt='.ISO') or }(sExt='.UDF') then Result.classid := CLSID_CFormatUdf else if (sExt='.XAR') then Result.classid := CLSID_CFormatXar else if (sExt='.MUB') then Result.classid := CLSID_CFormatMub else if (sExt='.HGS') or (sExt='.CD') then Result.classid := CLSID_CFormatHfs else if (sExt='.DMG') then Result.classid := CLSID_CFormatDmg else if (sExt='.MSI') or (sExt='.DOC') or (sExt='.XLS') or (sExt='.PPT') then Result.classid := CLSID_CFormatCompound else if (sExt='.WIM') or (sExt='.SWM') then Result.classid := CLSID_CFormatWim else if (sExt='.ISO') then Result.classid := CLSID_CFormatIso else if (sExt='.BKF') then Result.classid := CLSID_CFormatBkf else if (sExt='.CHM') or (sExt='.CHI') or (sExt='.CHQ') or (sExt='.CHW') or (sExt='.HXS') or (sExt='.HXI') or (sExt='.HXR') or (sExt='.HXQ') or (sExt='.HXW') or (sExt='.LIT') then Result.classid := CLSID_CFormatChm else if (sExt='.001') then Result.classid := CLSID_CFormatSplit else if (sExt='.RPM') then Result.classid := CLSID_CFormatRpm else if (sExt='.DEB') then Result.classid := CLSID_CFormatDeb else if (sExt='.CPIO') then Result.classid := CLSID_CFormatCpio else if (sExt='.TAR') then Result.classid := CLSID_CFormatTar else if (sExt='.GZ') or (sExt='.GZIP') or (sExt='.TGZ') or (sExt='.TPZ') then Result.classid := CLSID_CFormatGZip; Result.OpenFile(filename); end;
续上（发现百度插入源代码太长时需要分段才能审核过）
function CreateOutArchive(const classid: TGUID): I7zOutArchive;
begin
Result := T7zOutArchive.Create('7z.dll');
Result.classid := classid;
end;
{ T7zPlugin }
constructor T7zPlugin.Create(const lib: string);
begin
FHandle := LoadLibrary(PChar(lib));
if FHandle = 0 then
raise Exception.CreateFmt('Error loading library %s', [lib]);
FCreateObject := GetProcAddress(FHandle, 'CreateObject');
if not(Assigned(FCreateObject)) then
begin
FreeLibrary(FHandle);
raise Exception.CreateFmt('%s is not a 7z library', [lib]);
end;
end;
destructor T7zPlugin.Destroy;
begin
FreeLibrary(FHandle);
inherited;
end;
procedure T7zPlugin.CreateObject(const clsid, iid: TGUID; var obj);
var
hr: HRESULT;
begin
hr := FCreateObject(clsid, iid, obj);
if failed(hr) then
raise Exception.Create(SysErrorMessage(hr));
end;
{ T7zCodec }
constructor T7zCodec.Create(const lib: string);
begin
inherited;
FGetMethodProperty := GetProcAddress(FHandle, 'GetMethodProperty');
FGetNumberOfMethods := GetProcAddress(FHandle, 'GetNumberOfMethods');
if not(Assigned(FGetMethodProperty) and Assigned(FGetNumberOfMethods)) then
begin
FreeLibrary(FHandle);
raise Exception.CreateFmt('%s is not a codec library', [lib]);
end;
end;
function T7zCodec.GetDecoder(const index: Integer): ICompressCoder;
var
v: OleVariant;
begin
v := MethodProperty[index, kDecoder];
CreateObject(TPropVariant(v).puuid^, ICompressCoder, Result);
end;
function T7zCodec.GetEncoder(const index: Integer): ICompressCoder;
var
v: OleVariant;
begin
v := MethodProperty[index, kEncoder];
CreateObject(TPropVariant(v).puuid^, ICompressCoder, Result);
end;
function T7zCodec.GetMethodProperty(index: Cardinal; propID: NMethodPropID)
: OleVariant;
var
hr: HRESULT;
begin
hr := FGetMethodProperty(index, propID, Result);
if failed(hr) then
raise Exception.Create(SysErrorMessage(hr));
end;
function T7zCodec.GetName(const index: Integer): string;
begin
Result := MethodProperty[index, kName_];
end;
function T7zCodec.GetNumberOfMethods: Cardinal;
var
hr: HRESULT;
begin
hr := FGetNumberOfMethods(@Result);
if failed(hr) then
raise Exception.Create(SysErrorMessage(hr));
end;
function T7zCodec.SetRatioInfo(inSize, outSize: PInt64): HRESULT;
begin
Result := S_OK;
end;
{ T7zInArchive }
procedure T7zInArchive.Close; stdcall;
begin
FPasswordIsDefined := false;
FSubArchiveMode := false;
FInArchive.Close;
FInArchive := nil;
end;
constructor T7zInArchive.Create(const lib: string);
begin
inherited;
FPasswordCallback := nil;
FPasswordSender := nil;
FPasswordIsDefined := false;
FSubArchiveMode := false;
FExtractCallBack := nil;
FExtractSender := nil;
end;
destructor T7zInArchive.Destroy;
begin
FInArchive := nil;
inherited;
end;
function T7zInArchive.GetInArchive: IInArchive;
begin
if FInArchive = nil then
CreateObject(classid, IInArchive, FInArchive);
Result := FInArchive;
end;
function T7zInArchive.GetItemPath(const index: Integer): UnicodeString; stdcall;
begin
Result := UnicodeString(GetItemProp(index, kpidPath));
end;
function T7zInArchive.GetNumberOfItems: Cardinal; stdcall;
begin
RINOK(FInArchive.GetNumberOfItems(Result));
end;
procedure T7zInArchive.OpenFile(const filename: string); stdcall;
var
strm: IInStream;
begin
strm := T7zStream.Create(TFileStream.Create(filename, fmOpenRead or
fmShareDenyNone), soOwned);
try
RINOK(InArchive.Open(strm, @MAXCHECK, self as IArchiveOpenCallback));
finally
strm := nil;
end;
end;
procedure T7zInArchive.OpenStream(stream: IInStream); stdcall;
begin
RINOK(InArchive.Open(stream, @MAXCHECK, self as IArchiveOpenCallback));
end;
function T7zInArchive.GetItemIsFolder(const index: Integer): boolean; stdcall;
begin
Result := boolean(GetItemProp(index, kpidIsFolder));
end;
function T7zInArchive.GetItemProp(const item: Cardinal; prop: propID)
: OleVariant;
begin
FInArchive.GetProperty(item, prop, Result);
end;
procedure T7zInArchive.ExtractItem(const item: Cardinal; stream: TStream;
test: longbool); stdcall;
begin
FStream := stream;
try
if test then
RINOK(FInArchive.Extract(@item, 1, 1, self as IArchiveExtractCallback))
else
RINOK(FInArchive.Extract(@item, 1, 0, self as IArchiveExtractCallback));
finally
FStream := nil;
end;
end;
function T7zInArchive.GetStream(index: Cardinal;
var outStream: ISequentialOutStream; askExtractMode: NAskMode): HRESULT;
var
path: string;
begin
if askExtractMode = kExtract then
if FStream <> nil then
outStream := T7zStream.Create(FStream, soReference)
as ISequentialOutStream
else if Assigned(FExtractCallBack) then
begin
Result := FExtractCallBack(FExtractSender, index, outStream);
Exit;
end
else if FExtractPath <> '' then
begin
if not GetItemIsFolder(index) then
begin
path := FExtractPath + GetItemPath(index);
ForceDirectories(ExtractFilePath(path));
outStream := T7zStream.Create(TFileStream.Create(path,
fmCreate), soOwned);
end;
end;
Result := S_OK;
end;
function T7zInArchive.PrepareOperation(askExtractMode: NAskMode): HRESULT;
begin
Result := S_OK;
end;
function T7zInArchive.SetCompleted(completeValue: PInt64): HRESULT;
begin
if Assigned(FProgressCallback) and (completeValue <> nil) then
Result := FProgressCallback(FProgressSender, false, completeValue^)
else
Result := S_OK;
end;
function T7zInArchive.SetCompleted(files, bytes: PInt64): HRESULT;
begin
Result := S_OK;
end;
function T7zInArchive.SetOperationResult(resultEOperationResult
: NExtOperationResult): HRESULT;
begin
Result := S_OK;
end;
function T7zInArchive.SetTotal(total: Int64): HRESULT;
begin
if Assigned(FProgressCallback) then
Result := FProgressCallback(FProgressSender, true, total)
else
Result := S_OK;
end;
function T7zInArchive.SetTotal(files, bytes: PInt64): HRESULT;
begin
Result := S_OK;
end;
function T7zInArchive.CryptoGetTextPassword(var password: TBStr): HRESULT;
var
wpass: UnicodeString;
begin
if FPasswordIsDefined then
begin
password := SysAllocString(PWideChar(FPassword));
Result := S_OK;
end
else if Assigned(FPasswordCallback) then
begin
Result := FPasswordCallback(FPasswordSender, wpass);
if Result = S_OK then
begin
password := SysAllocString(PWideChar(wpass));
FPasswordIsDefined := true;
FPassword := wpass;
end;
end
else
Result := S_FALSE;
end;
function T7zInArchive.GetProperty(propID: propID;
var value: OleVariant): HRESULT;
begin
Result := S_OK;
end;
function T7zInArchive.GetStream(const name: PWideChar;
var inStream: IInStream): HRESULT;
begin
Result := S_OK;
end;
procedure T7zInArchive.SetPasswordCallback(sender: Pointer;
callback: T7zPasswordCallback); stdcall;
begin
FPasswordSender := sender;
FPasswordCallback := callback;
end;
function T7zInArchive.SetSubArchiveName(name: PWideChar): HRESULT;
begin
FSubArchiveMode := true;
FSubArchiveName := name;
Result := S_OK;
end;
function T7zInArchive.GetItemName(const index: Integer): UnicodeString; stdcall;
begin
Result := UnicodeString(GetItemProp(index, kpidName));
end;
function T7zInArchive.GetItemSize(const index: Integer): Cardinal; stdcall;
begin
Result := Cardinal(GetItemProp(index, kpidSize));
end;
procedure T7zInArchive.ExtractItems(items: PCardArray; count: Cardinal;
test: longbool; sender: Pointer; callback: T7zGetStreamCallBack); stdcall;
begin
FExtractCallBack := callback;
FExtractSender := sender;
try
if test then
RINOK(FInArchive.Extract(items, count, 1,
self as IArchiveExtractCallback))
else
RINOK(FInArchive.Extract(items, count, 0,
self as IArchiveExtractCallback));
finally
FExtractCallBack := nil;
FExtractSender := nil;
end;
end;
procedure T7zInArchive.SetProgressCallback(sender: Pointer;
callback: T7zProgressCallback); stdcall;
begin
FProgressSender := sender;
FProgressCallback := callback;
end;
procedure T7zInArchive.ExtractAll(test: longbool; sender: Pointer;
callback: T7zGetStreamCallBack);
begin
FExtractCallBack := callback;
FExtractSender := sender;
try
if test then
RINOK(FInArchive.Extract(nil, $FFFFFFFF, 1,
self as IArchiveExtractCallback))
else
RINOK(FInArchive.Extract(nil, $FFFFFFFF, 0,
self as IArchiveExtractCallback));
finally
FExtractCallBack := nil;
FExtractSender := nil;
end;
end;
procedure T7zInArchive.ExtractTo(const path: string);
begin
FExtractPath := IncludeTrailingPathDelimiter(path);
try
RINOK(FInArchive.Extract(nil, $FFFFFFFF, 0,
self as IArchiveExtractCallback));
finally
FExtractPath := '';
end;
end;
procedure T7zInArchive.SetPassword(const password: UnicodeString);
begin
FPassword := password;
FPasswordIsDefined := FPassword <> '';
end;
{ T7zArchive }
constructor T7zArchive.Create(const lib: string);
begin
inherited;
FGetHandlerProperty := GetProcAddress(FHandle, 'GetHandlerProperty');
if not Assigned(FGetHandlerProperty) then
begin
FreeLibrary(FHandle);
raise Exception.CreateFmt('%s is not a Format library', [lib]);
end;
FClassId := GUID_NULL;
end;
function T7zArchive.GetClassId: TGUID;
begin
Result := FClassId;
end;
function T7zArchive.GetHandlerProperty(const propID: NArchive): OleVariant;
var
hr: HRESULT;
begin
hr := FGetHandlerProperty(propID, Result);
if failed(hr) then
raise Exception.Create(SysErrorMessage(hr));
end;
function T7zArchive.GetLibGUIDProperty(const index: NArchive): TGUID;
var
v: OleVariant;
begin
v := HandlerProperty[index];
Result := TPropVariant(v).puuid^;
end;
function T7zArchive.GetLibStringProperty(const index: NArchive): string;
begin
Result := HandlerProperty[Index];
end;
procedure T7zArchive.SetClassId(const classid: TGUID);
begin
FClassId := classid;
end;
{ T7zStream }
constructor T7zStream.Create(stream: TStream; Ownership: TStreamOwnership);
begin
inherited Create;
FStream := stream;
FOwnership := Ownership;
end;
destructor T7zStream.Destroy;
begin
if FOwnership = soOwned then
begin
FStream.Free;
FStream := nil;
end;
inherited;
end;
function T7zStream.Flush: HRESULT;
begin
Result := S_OK;
end;
function T7zStream.GetSize(size: PInt64): HRESULT;
begin
if size <> nil then
size^ := FStream.size;
Result := S_OK;
end;
function T7zStream.Read(data: Pointer; size: Cardinal;
processedSize: PCardinal): HRESULT;
var
len: Integer;
begin
len := FStream.Read(data^, size);
if processedSize <> nil then
processedSize^ := len;
Result := S_OK;
end;
function T7zStream.Seek(offset: Int64; seekOrigin: Cardinal;
newPosition: PInt64): HRESULT;
begin
FStream.Seek(offset, TSeekOrigin(seekOrigin));
if newPosition <> nil then
newPosition^ := FStream.Position;
Result := S_OK;
end;
function T7zStream.SetSize(newSize: Int64): HRESULT;
begin
FStream.size := newSize;
Result := S_OK;
end;
function T7zStream.Write(data: Pointer; size: Cardinal;
processedSize: PCardinal): HRESULT;
var
len: Integer;
begin
len := FStream.Write(data^, size);
if processedSize <> nil then
processedSize^ := len;
Result := S_OK;
end;
type
TSourceMode = (smStream, smFile);
T7zBatchItem = class
SourceMode: TSourceMode;
stream: TStream;
Attributes: Cardinal;
CreationTime, LastWriteTime: TFileTime;
path: UnicodeString;
IsFolder, IsAnti: boolean;
filename: TFileName;
Ownership: TStreamOwnership;
size: Cardinal;
destructor Destroy; override;
end;
destructor T7zBatchItem.Destroy;
begin
if (Ownership = soOwned) and (stream <> nil) then
stream.Free;
inherited;
end;
{ T7zOutArchive }
procedure T7zOutArchive.AddFile(const filename: TFileName;
const path: UnicodeString);
var
item: T7zBatchItem;
Handle: THandle;
begin
if not FileExists(filename) then
Exit;
item := T7zBatchItem.Create;
item.SourceMode := smFile;
item.stream := nil;
item.filename := filename;
item.path := path;
Handle := FileOpen(filename, fmOpenRead or fmShareDenyNone);
GetFileTime(Handle, @item.CreationTime, nil, @item.LastWriteTime);
item.size := GetFileSize(Handle, nil);
CloseHandle(Handle);
item.Attributes := GetFileAttributes(PChar(filename));
item.IsFolder := false;
item.IsAnti := false;
item.Ownership := soOwned;
FBatchList.Add(item);
end;
procedure T7zOutArchive.AddFiles(const Dir, path, Willcards: string;
recurse: boolean);
var
lencut: Integer;
willlist: TStringList;
zedir: string;
procedure Traverse(p: string);
var
f: TSearchRec;
i: Integer;
item: T7zBatchItem;
begin
if recurse then
begin
if FindFirst(p + '*.*', faDirectory, f) = 0 then
repeat
if (f.name[1] <> '.') then
Traverse(IncludeTrailingPathDelimiter(p + f.name));
until FindNext(f) <> 0;
SysUtils.FindClose(f);
end;
for i := 0 to willlist.count - 1 do
begin
if FindFirst(p + willlist[i], faReadOnly or faHidden or faSysFile or
faArchive, f) = 0 then
repeat
item := T7zBatchItem.Create;
item.SourceMode := smFile;
item.stream := nil;
item.filename := p + f.name;
item.path := copy(item.filename, lencut, length(item.filename) -
lencut + 1);
if path <> '' then
item.path := IncludeTrailingPathDelimiter(path) + item.path;
item.CreationTime := f.FindData.ftCreationTime;
item.LastWriteTime := f.FindData.ftLastWriteTime;
item.Attributes := f.FindData.dwFileAttributes;
item.size := f.size;
item.IsFolder := false;
item.IsAnti := false;
item.Ownership := soOwned;
FBatchList.Add(item);
until FindNext(f) <> 0;
SysUtils.FindClose(f);
end;
end;
begin
willlist := TStringList.Create;
try
willlist.Delimiter := ';';
willlist.DelimitedText := Willcards;
zedir := IncludeTrailingPathDelimiter(Dir);
lencut := length(zedir) + 1;
Traverse(zedir);
finally
willlist.Free;
end;
end;
procedure T7zOutArchive.AddStream(stream: TStream; Ownership: TStreamOwnership;
Attributes: Cardinal; CreationTime, LastWriteTime: TFileTime;
const path: UnicodeString; IsFolder, IsAnti: boolean); stdcall;
var
item: T7zBatchItem;
begin
item := T7zBatchItem.Create;
item.SourceMode := smStream;
item.Attributes := Attributes;
item.CreationTime := CreationTime;
item.LastWriteTime := LastWriteTime;
item.path := path;
item.IsFolder := IsFolder;
item.IsAnti := IsAnti;
item.stream := stream;
item.size := stream.size;
item.Ownership := Ownership;
FBatchList.Add(item);
end;
procedure T7zOutArchive.CrearBatch;
begin
FBatchList.Clear;
end;
constructor T7zOutArchive.Create(const lib: string);
begin
inherited;
FBatchList := TObjectList.Create;
FProgressCallback := nil;
FProgressSender := nil;
end;
function T7zOutArchive.CryptoGetTextPassword2(passwordIsDefined: PInteger;
var password: TBStr): HRESULT;
begin
if FPassword <> '' then
begin
passwordIsDefined^ := 1;
password := SysAllocString(PWideChar(FPassword));
end
else
passwordIsDefined^ := 0;
Result := S_OK;
end;
destructor T7zOutArchive.Destroy;
begin
FOutArchive := nil;
FBatchList.Free;
inherited;
end;
function T7zOutArchive.GetOutArchive: IOutArchive;
begin
if FOutArchive = nil then
CreateObject(classid, IOutArchive, FOutArchive);
Result := FOutArchive;
end;
function T7zOutArchive.GetProperty(index: Cardinal; propID: propID;
var value: OleVariant): HRESULT;
var
item: T7zBatchItem;
begin
item := T7zBatchItem(FBatchList[index]);
case propID of
kpidAttributes:
begin
TPropVariant(value).vt := VT_UI4;
TPropVariant(value).ulVal := item.Attributes;
end;
kpidLastWriteTime:
begin
TPropVariant(value).vt := VT_FILETIME;
TPropVariant(value).filetime := item.LastWriteTime;
end;
kpidPath:
begin
if item.path <> '' then
value := item.path;
end;
kpidIsFolder:
value := item.IsFolder;
kpidSize:
begin
TPropVariant(value).vt := VT_UI8;
TPropVariant(value).uhVal.QuadPart := item.size;
end;
kpidCreationTime:
begin
TPropVariant(value).vt := VT_FILETIME;
TPropVariant(value).filetime := item.CreationTime;
end;
kpidIsAnti:
value := item.IsAnti;
else
// beep(0,0);
end;
Result := S_OK;
end;
function T7zOutArchive.GetStream(index: Cardinal;
var inStream: ISequentialInStream): HRESULT;
var
item: T7zBatchItem;
begin
item := T7zBatchItem(FBatchList[index]);
case item.SourceMode of
smFile:
inStream := T7zStream.Create(TFileStream.Create(item.filename,
fmOpenRead or fmShareDenyNone), soOwned);
smStream:
begin
item.stream.Seek(0, soFromBeginning);
inStream := T7zStream.Create(item.stream);
end;
end;
Result := S_OK;
end;
function T7zOutArchive.GetUpdateItemInfo(index: Cardinal;
newData, newProperties: PInteger; indexInArchive: PCardinal): HRESULT;
begin
newData^ := 1;
newProperties^ := 1;
indexInArchive^ := Cardinal(-1);
Result := S_OK;
end;
procedure T7zOutArchive.SaveToFile(const filename: TFileName);
var
f: TFileStream;
begin
f := TFileStream.Create(filename, fmCreate);
try
SaveToStream(f);
finally
f.Free;
end;
end;
procedure T7zOutArchive.SaveToStream(stream: TStream);
var
strm: ISequentialOutStream;
begin
strm := T7zStream.Create(stream);
try
RINOK(OutArchive.UpdateItems(strm, FBatchList.count,
self as IArchiveUpdateCallback));
finally
strm := nil;
end;
end;
function T7zOutArchive.SetCompleted(completeValue: PInt64): HRESULT;
begin
if Assigned(FProgressCallback) and (completeValue <> nil) then
Result := FProgressCallback(FProgressSender, false, completeValue^)
else
Res |
2023-10-27
2022-08-15
2022-08-17
2022-09-23
2022-08-13
六六分期app的软件客服如何联系？不知道吗？加qq群【895510560】即可！标题：六六分期
今天小编告诉大家如何处理win10系统火狐flash插件总是崩溃的问题，可能很多用户都不知
今天小编告诉大家如何对win10系统删除桌面回收站图标进行设置，可能很多用户都不知道
今天小编告诉大家如何对win10系统电脑设置节能降温的设置方法，想必大家都遇到过需要
我们在使用xp系统的过程中,经常需要对xp系统无线网络安装向导设置进行设置，可能很多
今天小编告诉大家如何处理win7系统玩cf老是与主机连接不稳定的问题，可能很多用户都不
电脑对日常生活的重要性小编就不多说了，可是一旦碰到win7系统设置cf烟雾头的问题，很
我们在日常使用电脑的时候，有的小伙伴们可能在打开应用的时候会遇见提示应用程序无法
今天小编告诉大家如何对win7系统打开vcf文件进行设置，可能很多用户都不知道怎么对win
今天小编告诉大家如何对win10系统s4开启USB调试模式进行设置，可能很多用户都不知道怎
请发表评论