1980 lines
68 KiB
Plaintext
1980 lines
68 KiB
Plaintext
(********************************************************************************)
|
|
(* 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 <hgourvest@gmail.com> *)
|
|
(* V1.2 *)
|
|
(********************************************************************************)
|
|
|
|
unit Process7zip;
|
|
{$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;
|
|
kpidMainSubfile = 1;
|
|
kpidHandlerItemIndex = 2;
|
|
kpidPath = 3; // VT_BSTR
|
|
kpidName = 4; // VT_BSTR
|
|
kpidExtension = 5; // VT_BSTR
|
|
kpidIsDir = 6; // VT_BOOL
|
|
kpidSize = 7; // VT_UI8
|
|
kpidPackSize = 8; // VT_UI8
|
|
kpidAttrib = 9; // VT_UI4
|
|
kpidCTime = 10; // VT_FILETIME
|
|
kpidATime = 11; // VT_FILETIME
|
|
kpidMTime = 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
|
|
kpidId = 49;
|
|
kpidShortName = 50;
|
|
kpidCreatorApp = 51;
|
|
kpidSectorSize = 52;
|
|
kpidPosixAttrib = 53;
|
|
kpidSymLink = 54;
|
|
kpidError = 55;
|
|
kpidTotalSize = 56;
|
|
kpidFreeSpace = 57;
|
|
kpidClusterSize = 58;
|
|
kpidVolumeName = 59;
|
|
kpidLocalName = 60;
|
|
kpidProvider = 61;
|
|
kpidNtSecure = 62;
|
|
kpidIsAltStream = 63;
|
|
kpidIsAux = 64;
|
|
kpidIsDeleted = 65;
|
|
kpidIsTree = 66;
|
|
kpidSha1 = 67;
|
|
kpidSha256 = 68;
|
|
kpidErrorType = 69;
|
|
kpidNumErrors = 70;
|
|
kpidErrorFlags = 71;
|
|
kpidWarningFlags = 72;
|
|
kpidWarning = 73;
|
|
kpidNumStreams = 74;
|
|
kpidNumAltStreams = 75;
|
|
kpidAltStreamsSize = 76;
|
|
kpidVirtualSize = 77;
|
|
kpidUnpackSize = 78;
|
|
kpidTotalPhySize = 79;
|
|
kpidVolumeIndex = 80;
|
|
kpidSubType = 81;
|
|
kpidShortComment = 82;
|
|
kpidCodePage = 83;
|
|
kpidIsNotArcType = 84;
|
|
kpidPhySizeCantBeDetected = 85;
|
|
kpidZerosTailIsAllowed = 86;
|
|
kpidTailSize = 87;
|
|
kpidEmbeddedStubSize = 88;
|
|
kpidNtReparse = 89;
|
|
kpidHardLink = 90;
|
|
kpidINode = 91;
|
|
kpidStreamId = 92;
|
|
kpidReadOnly = 93;
|
|
kpidOutName = 94;
|
|
kpidCopyLink = 95;
|
|
|
|
// 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;
|
|
(*
|
|
The requirement for caller: (processedSize != NULL).
|
|
The callee can allow (processedSize == NULL) for compatibility reasons.
|
|
|
|
if (size == 0), this function returns S_OK and (*processedSize) is set to 0.
|
|
|
|
if (size != 0)
|
|
{
|
|
Partial read is allowed: (*processedSize <= avail_size && *processedSize <= size),
|
|
where (avail_size) is the size of remaining bytes in stream.
|
|
If (avail_size != 0), this function must read at least 1 byte: (*processedSize > 0).
|
|
You must call Read() in loop, if you need to read exact amount of data.
|
|
}
|
|
|
|
If seek pointer before Read() call was changed to position past the end of stream:
|
|
if (seek_pointer >= stream_size), this function returns S_OK and (*processedSize) is set to 0.
|
|
|
|
ERROR CASES:
|
|
If the function returns error code, then (*processedSize) is size of
|
|
data written to (data) buffer (it can be data before error or data with errors).
|
|
The recommended way for callee to work with reading errors:
|
|
1) write part of data before error to (data) buffer and return S_OK.
|
|
2) return error code for further calls of Read().
|
|
*)
|
|
end;
|
|
|
|
ISequentialOutStream = interface(IUnknown)
|
|
['{23170F69-40C1-278A-0000-000300020000}']
|
|
function Write(data: Pointer; size: Cardinal; processedSize: PCardinal): HRESULT; stdcall;
|
|
(*
|
|
The requirement for caller: (processedSize != NULL).
|
|
The callee can allow (processedSize == NULL) for compatibility reasons.
|
|
|
|
if (size != 0)
|
|
{
|
|
Partial write is allowed: (*processedSize <= size),
|
|
but this function must write at least 1 byte: (*processedSize > 0).
|
|
You must call Write() in loop, if you need to write exact amount of data.
|
|
}
|
|
|
|
ERROR CASES:
|
|
If the function returns error code, then (*processedSize) is size of
|
|
data written from (data) buffer.
|
|
*)
|
|
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;
|
|
|
|
IOutStreamFinish = 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
|
|
);
|
|
|
|
// NArcInfoFlags
|
|
NArcInfoFlags = (
|
|
aifKeepName = 1 shl 0, // keep name of file in archive name
|
|
aifAltStreams = 1 shl 1, // the handler supports alt streams
|
|
aifNtSecure = 1 shl 2, // the handler supports NT security
|
|
aifFindSignature = 1 shl 3, // the handler can find start of archive
|
|
aifMultiSignature = 1 shl 4, // there are several signatures
|
|
aifUseGlobalOffset = 1 shl 5, // the seek position of stream must be set as global offset
|
|
aifStartOpen = 1 shl 6, // call handler for each start position
|
|
aifPureStartOpen = 1 shl 7, // call handler only for start of file
|
|
aifBackwardOpen = 1 shl 8, // archive can be open backward
|
|
aifPreArc = 1 shl 9, // such archive can be stored before real archive (like SFX stub)
|
|
aifSymLinks = 1 shl 10, // the handler supports symbolic links
|
|
aifHardLinks = 1 shl 11 // the handler supports hard links
|
|
);
|
|
|
|
// NArchive::NHandlerPropID
|
|
NHandlerPropID = (
|
|
kName = 0, // VT_BSTR
|
|
kClassID, // binary GUID in VT_BSTR
|
|
kExtension, // VT_BSTR
|
|
kAddExtension, // VT_BSTR
|
|
kUpdate, // VT_BOOL
|
|
kKeepName, // VT_BOOL
|
|
kSignature, // binary in VT_BSTR
|
|
kMultiSignature, // binary in VT_BSTR
|
|
kSignatureOffset, // VT_UI4
|
|
kAltStreams, // VT_BOOL
|
|
kNtSecure, // VT_BOOL
|
|
kFlags // VT_UI4
|
|
// kVersion // VT_UI4 ((VER_MAJOR << 8) | VER_MINOR)
|
|
);
|
|
|
|
// NArchive::NExtract::NAskMode
|
|
NAskMode = (
|
|
kExtract = 0,
|
|
kTest,
|
|
kSkip
|
|
);
|
|
|
|
// NArchive::NExtract::NOperationResult
|
|
NExtOperationResult = (
|
|
kOK = 0,
|
|
kUnSupportedMethod,
|
|
kDataError,
|
|
kCRCError,
|
|
kUnavailable,
|
|
kUnexpectedEnd,
|
|
kDataAfterEnd,
|
|
kIsNotArc,
|
|
kHeadersError,
|
|
kWrongPassword
|
|
);
|
|
|
|
// NArchive::NEventIndexType
|
|
NEventIndexType = (
|
|
kNoIndex = 0,
|
|
kInArcIndex,
|
|
kBlockIndex,
|
|
kOutArcIndex
|
|
);
|
|
|
|
// 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;
|
|
(*
|
|
IArchiveExtractCallback::
|
|
|
|
7-Zip doesn't call IArchiveExtractCallback functions
|
|
GetStream()
|
|
PrepareOperation()
|
|
SetOperationResult()
|
|
from different threads simultaneously.
|
|
But 7-Zip can call functions for IProgress or ICompressProgressInfo functions
|
|
from another threads simultaneously with calls for IArchiveExtractCallback interface.
|
|
|
|
IArchiveExtractCallback::GetStream()
|
|
UInt32 index - index of item in Archive
|
|
Int32 askExtractMode (Extract::NAskMode)
|
|
if (askMode != NExtract::NAskMode::kExtract)
|
|
{
|
|
then the callee can not real stream: (*inStream == NULL)
|
|
}
|
|
|
|
Out:
|
|
(*inStream == NULL) - for directories
|
|
(*inStream == NULL) - if link (hard link or symbolic link) was created
|
|
if (*inStream == NULL && askMode == NExtract::NAskMode::kExtract)
|
|
{
|
|
then the caller must skip extracting of that file.
|
|
}
|
|
|
|
returns:
|
|
S_OK : OK
|
|
S_FALSE : data error (for decoders)
|
|
|
|
if (IProgress::SetTotal() was called)
|
|
{
|
|
IProgress::SetCompleted(completeValue) uses
|
|
packSize - for some stream formats (xz, gz, bz2, lzma, z, ppmd).
|
|
unpackSize - for another formats.
|
|
}
|
|
else
|
|
{
|
|
IProgress::SetCompleted(completeValue) uses packSize.
|
|
}
|
|
|
|
SetOperationResult()
|
|
7-Zip calls SetOperationResult at the end of extracting,
|
|
so the callee can close the file, set attributes, timestamps and security information.
|
|
|
|
Int32 opRes (NExtract::NOperationResult)
|
|
*)
|
|
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;
|
|
(*
|
|
IArchiveExtractCallbackMessage can be requested from IArchiveExtractCallback object
|
|
by Extract() or UpdateItems() functions to report about extracting errors
|
|
ReportExtractResult()
|
|
UInt32 indexType (NEventIndexType)
|
|
UInt32 index
|
|
Int32 opRes (NExtract::NOperationResult)
|
|
*)
|
|
end;
|
|
|
|
IArchiveExtractCallbackMessage = interface
|
|
['{23170F69-40C1-278A-0000-000600210000}']
|
|
function ReportExtractResult(indexType: NEventIndexType; index: Cardinal; opRes: Integer): 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;
|
|
(*
|
|
IInArchive::Open
|
|
stream
|
|
if (kUseGlobalOffset), stream current position can be non 0.
|
|
if (!kUseGlobalOffset), stream current position is 0.
|
|
if (maxCheckStartPosition == NULL), the handler can try to search archive start in stream
|
|
if (*maxCheckStartPosition == 0), the handler must check only current position as archive start
|
|
|
|
IInArchive::Extract:
|
|
indices must be sorted
|
|
numItems = (UInt32)(Int32)-1 = 0xFFFFFFFF means "all files"
|
|
testMode != 0 means "test files without writing to outStream"
|
|
|
|
IInArchive::GetArchiveProperty:
|
|
kpidOffset - start offset of archive.
|
|
VT_EMPTY : means offset = 0.
|
|
VT_UI4, VT_UI8, VT_I8 : result offset; negative values is allowed
|
|
kpidPhySize - size of archive. VT_EMPTY means unknown size.
|
|
kpidPhySize is allowed to be larger than file size. In that case it must show
|
|
supposed size.
|
|
|
|
kpidIsDeleted:
|
|
kpidIsAltStream:
|
|
kpidIsAux:
|
|
kpidINode:
|
|
must return VARIANT_TRUE (VT_BOOL), if archive can support that property in GetProperty.
|
|
|
|
|
|
Notes:
|
|
Don't call IInArchive functions for same IInArchive object from different threads simultaneously.
|
|
Some IInArchive handlers will work incorrectly in that case.
|
|
*)
|
|
|
|
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;
|
|
|
|
IArchiveOpenSeq = interface
|
|
['{23170F69-40C1-278A-0000-000600610000}']
|
|
function OpenSeq(var stream: ISequentialInStream): HRESULT; stdcall;
|
|
end;
|
|
|
|
// NParentType::
|
|
NParentType = (
|
|
kDir = 0,
|
|
kAltStream
|
|
);
|
|
|
|
// NPropDataType::
|
|
NPropDataType = (
|
|
kMask_ZeroEnd = $10, // 1 shl 4,
|
|
// kMask_BigEndian = 1 shl 5,
|
|
kMask_Utf = $40, // 1 shl 6,
|
|
kMask_Utf8 = $40, // kMask_Utf or 0,
|
|
kMask_Utf16 = $41, // kMask_Utf or 1,
|
|
// kMask_Utf32 = $42, // kMask_Utf or 2,
|
|
|
|
kNotDefined = 0,
|
|
kRaw = 1,
|
|
|
|
kUtf8z = $50, // kMask_Utf8 or kMask_ZeroEnd,
|
|
kUtf16z = $51 // kMask_Utf16 or kMask_ZeroEnd
|
|
);
|
|
|
|
IArchiveGetRawProps = interface
|
|
['{23170F69-40C1-278A-0000-000600700000}']
|
|
function GetParent(index: Cardinal; var parent: Cardinal; var parentType: Cardinal): HRESULT; stdcall;
|
|
function GetRawProp(index: Cardinal; propID: PROPID; var data: Pointer; var dataSize: Cardinal; var propType: Cardinal): HRESULT; stdcall;
|
|
function GetNumRawProps(var numProps: Cardinal): HRESULT; stdcall;
|
|
function GetRawPropInfo(index: Cardinal; name: PBSTR; var propID: PROPID): HRESULT; stdcall;
|
|
end;
|
|
|
|
IArchiveGetRootProps = interface
|
|
['{23170F69-40C1-278A-0000-000600710000}']
|
|
function GetRootProp(propID: PROPID; var value: PROPVARIANT): HRESULT; stdcall;
|
|
function GetRootRawProp(propID: PROPID; var data: Pointer; var dataSize: Cardinal; var propType: Cardinal): 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;
|
|
|
|
//NCoderPropID::
|
|
NCoderPropID = (
|
|
kDefaultProp = 0,
|
|
kDictionarySize,
|
|
kUsedMemorySize,
|
|
kOrder,
|
|
kBlockSize,
|
|
kPosStateBits,
|
|
kLitContextBits,
|
|
kLitPosBits,
|
|
kNumFastBytes,
|
|
kMatchFinder,
|
|
kMatchFinderCycles,
|
|
kNumPasses,
|
|
kAlgorithm,
|
|
kNumThreads,
|
|
kEndMarker,
|
|
kLevel,
|
|
kReduceSize // estimated size of data that will be compressed. Encoder can use this value to reduce dictionary size.
|
|
);
|
|
|
|
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,
|
|
kMethodName, // kName
|
|
kDecoder,
|
|
kEncoder,
|
|
kPackStreams,
|
|
kUnpackStreams,
|
|
kDescription,
|
|
kDecoderIsAssigned,
|
|
kEncoderIsAssigned,
|
|
kDigestSize
|
|
);
|
|
|
|
//******************************************************************************
|
|
// 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;
|
|
// :: 171107 function GetItemSize(const index: integer): Cardinal; stdcall;
|
|
function GetItemSize(const index: integer): Int64; 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;
|
|
function ExtractTo(const path: string): NExtOperationResult; 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;
|
|
// :: 171107 property ItemSize[const index: integer]: Cardinal read GetItemSize;
|
|
property ItemSize[const index: integer]: Int64 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, Wildcard: string; recurse: boolean); stdcall;
|
|
procedure SaveToFile(const FileName: TFileName); stdcall;
|
|
procedure SaveToStream(stream: TStream); stdcall;
|
|
procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall;
|
|
procedure ClearBatch; 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, IOutStreamFinish)
|
|
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, mzLZMA, mzPPMD);
|
|
TZipEncryptionMethod = (emAES128, emAES192, emAES256, emZIPCRYPTO);
|
|
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 SetEncryptionMethod(Arch: I7zOutArchive; method: TZipEncryptionMethod); // X
|
|
procedure SetDictionnarySize(Arch: I7zOutArchive; size: Cardinal); // < 32 // X X
|
|
procedure SetMemorySize(Arch: I7zOutArchive; size: Cardinal); // 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; const lib: string = '7z.dll'): I7zInArchive;
|
|
function CreateOutArchive(const classid: TGUID; const lib: string = '7z.dll'): I7zOutArchive;
|
|
|
|
const
|
|
CLSID_CFormatZip : TGUID = '{23170F69-40C1-278A-1000-000110010000}'; // [OUT] zip jar xpi
|
|
CLSID_CFormatBZ2 : TGUID = '{23170F69-40C1-278A-1000-000110020000}'; // [OUT] bz2 bzip2 tbz2 tbz
|
|
CLSID_CFormatRar : TGUID = '{23170F69-40C1-278A-1000-000110030000}'; // [IN ] rar r00
|
|
CLSID_CFormatArj : TGUID = '{23170F69-40C1-278A-1000-000110040000}'; // [IN ] arj
|
|
CLSID_CFormatZ : TGUID = '{23170F69-40C1-278A-1000-000110050000}'; // [IN ] z taz
|
|
CLSID_CFormatLzh : TGUID = '{23170F69-40C1-278A-1000-000110060000}'; // [IN ] lzh lha
|
|
CLSID_CFormat7z : TGUID = '{23170F69-40C1-278A-1000-000110070000}'; // [OUT] 7z
|
|
CLSID_CFormatCab : TGUID = '{23170F69-40C1-278A-1000-000110080000}'; // [IN ] cab
|
|
CLSID_CFormatNsis : TGUID = '{23170F69-40C1-278A-1000-000110090000}'; // [IN ] nsis
|
|
CLSID_CFormatLzma : TGUID = '{23170F69-40C1-278A-1000-0001100A0000}'; // [IN ] lzma
|
|
CLSID_CFormatLzma86 : TGUID = '{23170F69-40C1-278A-1000-0001100B0000}'; // [IN ] lzma 86
|
|
CLSID_CFormatXz : TGUID = '{23170F69-40C1-278A-1000-0001100C0000}'; // [OUT] xz
|
|
CLSID_CFormatPpmd : TGUID = '{23170F69-40C1-278A-1000-0001100D0000}'; // [IN ] ppmd
|
|
|
|
CLSID_CFormatExt : TGUID = '{23170F69-40C1-278A-1000-000110C70000}'; // [IN ] ext
|
|
CLSID_CFormatVMDK : TGUID = '{23170F69-40C1-278A-1000-000110C80000}'; // [IN ] vmdk
|
|
CLSID_CFormatVDI : TGUID = '{23170F69-40C1-278A-1000-000110C90000}'; // [IN ] vdi
|
|
CLSID_CFormatQcow : TGUID = '{23170F69-40C1-278A-1000-000110CA0000}'; // [IN ] qcow
|
|
CLSID_CFormatGPT : TGUID = '{23170F69-40C1-278A-1000-000110CB0000}'; // [IN ] GPT
|
|
CLSID_CFormatRar5 : TGUID = '{23170F69-40C1-278A-1000-000110CC0000}'; // [IN ] Rar5
|
|
CLSID_CFormatIHex : TGUID = '{23170F69-40C1-278A-1000-000110CD0000}'; // [IN ] IHex
|
|
CLSID_CFormatHxs : TGUID = '{23170F69-40C1-278A-1000-000110CE0000}'; // [IN ] Hxs
|
|
CLSID_CFormatTE : TGUID = '{23170F69-40C1-278A-1000-000110CF0000}'; // [IN ] TE
|
|
CLSID_CFormatUEFIc : TGUID = '{23170F69-40C1-278A-1000-000110D00000}'; // [IN ] UEFIc
|
|
CLSID_CFormatUEFIs : TGUID = '{23170F69-40C1-278A-1000-000110D10000}'; // [IN ] UEFIs
|
|
CLSID_CFormatSquashFS : TGUID = '{23170F69-40C1-278A-1000-000110D20000}'; // [IN ] SquashFS
|
|
CLSID_CFormatCramFS : TGUID = '{23170F69-40C1-278A-1000-000110D30000}'; // [IN ] CramFS
|
|
CLSID_CFormatAPM : TGUID = '{23170F69-40C1-278A-1000-000110D40000}'; // [IN ] APM
|
|
CLSID_CFormatMslz : TGUID = '{23170F69-40C1-278A-1000-000110D50000}'; // [IN ] MsLZ
|
|
CLSID_CFormatFlv : TGUID = '{23170F69-40C1-278A-1000-000110D60000}'; // [IN ] FLV
|
|
CLSID_CFormatSwf : TGUID = '{23170F69-40C1-278A-1000-000110D70000}'; // [IN ] SWF
|
|
CLSID_CFormatSwfc : TGUID = '{23170F69-40C1-278A-1000-000110D80000}'; // [IN ] SWFC
|
|
CLSID_CFormatNtfs : TGUID = '{23170F69-40C1-278A-1000-000110D90000}'; // [IN ] NTFS
|
|
CLSID_CFormatFat : TGUID = '{23170F69-40C1-278A-1000-000110DA0000}'; // [IN ] FAT
|
|
CLSID_CFormatMbr : TGUID = '{23170F69-40C1-278A-1000-000110DB0000}'; // [IN ] MBR
|
|
CLSID_CFormatVhd : TGUID = '{23170F69-40C1-278A-1000-000110DC0000}'; // [IN ] VHD
|
|
CLSID_CFormatPe : TGUID = '{23170F69-40C1-278A-1000-000110DD0000}'; // [IN ] PE (Windows Exe)
|
|
CLSID_CFormatElf : TGUID = '{23170F69-40C1-278A-1000-000110DE0000}'; // [IN ] ELF (Linux Exe)
|
|
CLSID_CFormatMachO : TGUID = '{23170F69-40C1-278A-1000-000110DF0000}'; // [IN ] Mach-O
|
|
CLSID_CFormatUdf : TGUID = '{23170F69-40C1-278A-1000-000110E00000}'; // [IN ] iso
|
|
CLSID_CFormatXar : TGUID = '{23170F69-40C1-278A-1000-000110E10000}'; // [IN ] xar
|
|
CLSID_CFormatMub : TGUID = '{23170F69-40C1-278A-1000-000110E20000}'; // [IN ] mub
|
|
CLSID_CFormatHfs : TGUID = '{23170F69-40C1-278A-1000-000110E30000}'; // [IN ] HFS
|
|
CLSID_CFormatDmg : TGUID = '{23170F69-40C1-278A-1000-000110E40000}'; // [IN ] dmg
|
|
CLSID_CFormatCompound : TGUID = '{23170F69-40C1-278A-1000-000110E50000}'; // [IN ] msi doc xls ppt
|
|
CLSID_CFormatWim : TGUID = '{23170F69-40C1-278A-1000-000110E60000}'; // [OUT] wim swm
|
|
CLSID_CFormatIso : TGUID = '{23170F69-40C1-278A-1000-000110E70000}'; // [IN ] iso
|
|
CLSID_CFormatBkf : TGUID = '{23170F69-40C1-278A-1000-000110E80000}'; // [IN ] BKF
|
|
CLSID_CFormatChm : TGUID = '{23170F69-40C1-278A-1000-000110E90000}'; // [IN ] chm chi chq chw hxs hxi hxr hxq hxw lit
|
|
CLSID_CFormatSplit : TGUID = '{23170F69-40C1-278A-1000-000110EA0000}'; // [IN ] 001
|
|
CLSID_CFormatRpm : TGUID = '{23170F69-40C1-278A-1000-000110EB0000}'; // [IN ] rpm
|
|
CLSID_CFormatDeb : TGUID = '{23170F69-40C1-278A-1000-000110EC0000}'; // [IN ] deb
|
|
CLSID_CFormatCpio : TGUID = '{23170F69-40C1-278A-1000-000110ED0000}'; // [IN ] cpio
|
|
CLSID_CFormatTar : TGUID = '{23170F69-40C1-278A-1000-000110EE0000}'; // [OUT] tar
|
|
CLSID_CFormatGZip : TGUID = '{23170F69-40C1-278A-1000-000110EF0000}'; // [OUT] gz gzip tgz tpz
|
|
|
|
implementation
|
|
|
|
const
|
|
MAXCHECK : int64 = (1 shl 20);
|
|
ZipCompressionMethod: array[TZipCompressionMethod] of UnicodeString = ('COPY', 'DEFLATE', 'DEFLATE64', 'BZIP2', 'LZMA', 'PPMD');
|
|
ZipEncryptionMethod: array[TZipEncryptionMethod] of UnicodeString = ('AES128', 'AES192', 'AES256', 'ZIPCRYPTO');
|
|
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 SetEncryptionMethod(Arch: I7zOutArchive; method: TZipEncryptionMethod);
|
|
begin
|
|
Arch.SetPropertie('EM', ZipEncryptionMethod[method]);
|
|
end;
|
|
|
|
procedure SetDictionnarySize(Arch: I7zOutArchive; size: Cardinal);
|
|
begin
|
|
SetCardinalProperty(arch, 'D', size);
|
|
end;
|
|
|
|
procedure SetMemorySize(Arch: I7zOutArchive; size: Cardinal);
|
|
begin
|
|
SetCardinalProperty(arch, 'MEM', 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: NHandlerPropID; var value: OleVariant): HRESULT; stdcall;
|
|
FClassId: TGUID;
|
|
procedure SetClassId(const classid: TGUID);
|
|
function GetClassId: TGUID;
|
|
public
|
|
function GetHandlerProperty(const propID: NHandlerPropID): OleVariant;
|
|
function GetLibStringProperty(const Index: NHandlerPropID): string;
|
|
function GetLibGUIDProperty(const Index: NHandlerPropID): TGUID;
|
|
constructor Create(const lib: string); override;
|
|
property HandlerProperty[const propID: NHandlerPropID]: 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;
|
|
|
|
FLastExtractError: NExtOperationResult; // [MGKIM] 압축 해제 에러를 기록할 변수 추가
|
|
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;
|
|
// :: 171107 function GetItemSize(const index: integer): Cardinal; stdcall; stdcall;
|
|
function GetItemSize(const index: integer): Int64; 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;
|
|
function ExtractTo(const path: string): NExtOperationResult; stdcall; // procedure를 function으로 변경
|
|
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, Wildcard: string; recurse: boolean); stdcall;
|
|
procedure SaveToFile(const FileName: TFileName); stdcall;
|
|
procedure SaveToStream(stream: TStream); stdcall;
|
|
procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall;
|
|
procedure ClearBatch; 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; const lib: string): I7zInArchive;
|
|
begin
|
|
Result := T7zInArchive.Create(lib);
|
|
Result.ClassId := classid;
|
|
end;
|
|
|
|
function CreateOutArchive(const classid: TGUID; const lib: string): I7zOutArchive;
|
|
begin
|
|
Result := T7zOutArchive.Create(lib);
|
|
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, kMethodName];
|
|
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, kpidIsDir));
|
|
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;
|
|
// kOK(0)가 아니면 에러 상태를 저장
|
|
if resultEOperationResult <> kOK then
|
|
FLastExtractError := resultEOperationResult;
|
|
|
|
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;
|
|
|
|
// :: 171107 function T7zInArchive.GetItemSize(const index: integer): Cardinal; stdcall;
|
|
function T7zInArchive.GetItemSize(const index: integer): Int64; stdcall; // :: 171107
|
|
begin
|
|
// :: 171107 Result := Cardinal(GetItemProp(index, kpidSize));
|
|
Result := GetItemProp(index, kpidSize); // :: 171107
|
|
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;
|
|
|
|
function T7zInArchive.ExtractTo(const path: string): NExtOperationResult; stdcall;
|
|
//procedure T7zInArchive.ExtractTo(const path: string);
|
|
begin
|
|
// FExtractPath := IncludeTrailingPathDelimiter(path);
|
|
// try
|
|
// RINOK(FInArchive.Extract(nil, $FFFFFFFF, 0, self as IArchiveExtractCallback));
|
|
// finally
|
|
// FExtractPath := '';
|
|
// end;
|
|
FLastExtractError := kOK; // 시작 전 에러 상태 초기화
|
|
FExtractPath := IncludeTrailingPathDelimiter(path);
|
|
try
|
|
try
|
|
// RINOK는 치명적 에러 시 Exception을 발생시킴
|
|
RINOK(FInArchive.Extract(nil, $FFFFFFFF, 0, self as IArchiveExtractCallback));
|
|
|
|
Result:= FLastExtractError;
|
|
// 개별 파일 처리 중 에러(비밀번호 틀림 등)가 있었는지 확인
|
|
// if FLastExtractError <> kOK then
|
|
// Result := False
|
|
// else
|
|
// Result := True;
|
|
except
|
|
Result := kUnexpectedEnd; // COM 예외 발생 시 실패 처리
|
|
end;
|
|
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: NHandlerPropID): OleVariant;
|
|
var
|
|
hr: HRESULT;
|
|
begin
|
|
hr := FGetHandlerProperty(propID, Result);
|
|
if Failed(hr) then
|
|
raise Exception.Create(SysErrorMessage(hr));
|
|
end;
|
|
|
|
function T7zArchive.GetLibGUIDProperty(const Index: NHandlerPropID): TGUID;
|
|
var
|
|
v: OleVariant;
|
|
begin
|
|
v := HandlerProperty[index];
|
|
Result := TPropVariant(v).puuid^;
|
|
end;
|
|
|
|
function T7zArchive.GetLibStringProperty(const Index: NHandlerPropID): 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, Wildcard: 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 := Wildcard;
|
|
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.ClearBatch;
|
|
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
|
|
kpidAttrib:
|
|
begin
|
|
TPropVariant(Value).vt := VT_UI4;
|
|
TPropVariant(Value).ulVal := item.Attributes;
|
|
end;
|
|
kpidMTime:
|
|
begin
|
|
TPropVariant(value).vt := VT_FILETIME;
|
|
TPropVariant(value).filetime := item.LastWriteTime;
|
|
end;
|
|
kpidPath:
|
|
begin
|
|
if item.Path <> '' then
|
|
value := item.Path;
|
|
end;
|
|
kpidIsDir: Value := item.IsFolder;
|
|
kpidSize:
|
|
begin
|
|
TPropVariant(Value).vt := VT_UI8;
|
|
TPropVariant(Value).uhVal.QuadPart := item.Size;
|
|
end;
|
|
kpidCTime:
|
|
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
|
|
Result := S_OK;
|
|
end;
|
|
|
|
function T7zOutArchive.SetOperationResult(
|
|
operationResult: Integer): HRESULT;
|
|
begin
|
|
Result := S_OK;
|
|
end;
|
|
|
|
procedure T7zOutArchive.SetPassword(const password: UnicodeString);
|
|
begin
|
|
FPassword := password;
|
|
end;
|
|
|
|
procedure T7zOutArchive.SetProgressCallback(sender: Pointer;
|
|
callback: T7zProgressCallback);
|
|
begin
|
|
FProgressCallback := callback;
|
|
FProgressSender := sender;
|
|
end;
|
|
|
|
procedure T7zOutArchive.SetPropertie(name: UnicodeString;
|
|
value: OleVariant);
|
|
var
|
|
intf: ISetProperties;
|
|
p: PWideChar;
|
|
begin
|
|
intf := OutArchive as ISetProperties;
|
|
p := PWideChar(name);
|
|
RINOK(intf.SetProperties(@p, @TPropVariant(value), 1));
|
|
end;
|
|
|
|
function T7zOutArchive.SetTotal(total: Int64): HRESULT;
|
|
begin
|
|
if Assigned(FProgressCallback) then
|
|
Result := FProgressCallback(FProgressSender, true, total) else
|
|
Result := S_OK;
|
|
end;
|
|
|
|
end.
|