一、首先引入两个写好的单元：
1、D7zUtils.pas
unit D7zUtils;
interface
uses
SysUtils, Classes, Sevenzip;
type
TD7zFileType = (dftZip, dftBZ2, dftRar, dftArj, dftZ, dftLzh, dft7z, dftCab, dftNsis, dftLzma,
dftPe, dftElf, dftMacho, dftUdf, dftXar, dftMub, dftHfs, dftDmg, dftCompound,
dftWim, dftIso, dftBkf, dftChm, dftSplit, dftRpm, dftDeb, dftCpio, dftTar,
dftGZip);
TD7zFileTypes = set of TD7zFileType;
TD7zipStrings = TStrings;
TD7zipStringList = class(TStringList)
public
constructor Create();virtual;
end;
TOnPassword = procedure (Sender: TObject; var sPassword: WideString; var bContinue:Boolean) of object;
TOnProgress = procedure (Sender: TObject; bIsTotal: boolean; iValue: Int64; var bContinue:Boolean) of object;
TD7zipFile = class
private
FInArchive: I7zInArchive;
FItems: TD7zipStrings;
FTmpStream: TStream;
private
FCurrentItemPath: WideString;
FOnPassword: TOnPassword;
FOnProgress: TOnProgress;
private
FPasswordCallback: T7zPasswordCallback;
FProgressCallback: T7zProgressCallback;
function DoOnPassword(var sPassword: WideString): HRESULT;
function DoOnProgress(bIsTotal: boolean; iValue: Int64): HRESULT;
public
constructor Create();virtual;
destructor Destroy;override;
function LoadFromFile(AFileName: WideString):Boolean;
function LoadFromStream(AStream: TStream; AFileTypes: TD7zFileTypes=[]):Boolean;overload;
function LoadFromStream(AStream: TStream; AFileType: TD7zFileType):Boolean;overload;
public
function GetItems(sPath: WideString; iFilter: Integer=0): TD7zipStrings;//iFilter： 0-All 1-File 2 Dir ; sPath-暂不支持通配符
public
function ExtractItemToStream(sFileName: WideString; AStream: TStream):Boolean; //解压/获取单个文件
function ExtractItemToFile(sFileName: WideString; sToFile: WideString):Boolean;//解压/获取单个文件
public
property CurrentItemPath: WideString read FCurrentItemPath;
public
//fileSystem functions
function FileExists(sFileName: WideString):Boolean;
function DirectoryExists(sDirName: WideString):Boolean;
function GetCurrentDir(): WideString;
public
property OnPassword: TOnPassword read FOnPassword write FOnPassword;
property OnProgress: TOnProgress read FOnProgress write FOnProgress;
end;
implementation
function FUNC_PasswordCallback(sender: Pointer; var password: UnicodeString): HRESULT; stdcall;
begin
// call a dialog box ...
//password := 'password';
//Result := S_OK;
Result := S_FALSE;
if sender=nil then Exit;
Result := TD7zipFile(sender).DoOnPassword(password);
end;
function FUNC_ProgressCallback(sender: Pointer; total: boolean;
value: Int64): HRESULT; stdcall;
begin
Result := S_FALSE;
if sender=nil then Exit;
Result := TD7zipFile(sender).DoOnProgress(total, value);
end;
{ TD7zipFile }
constructor TD7zipFile.Create;
begin
FItems:=TD7zipStringList.Create;
FPasswordCallback := FUNC_PasswordCallback;
FProgressCallback := FUNC_ProgressCallback;
end;
destructor TD7zipFile.Destroy;
begin
FItems.Free;
FreeAndNil(FTmpStream);
inherited;
end;
function TD7zipFile.DirectoryExists(sDirName: WideString): Boolean;
var
iIndex:Integer;
begin
Result := False;
if FInArchive=nil then Exit;
if sDirName<>'' then
if sDirName[Length(sDirName)]<>'\' then
sDirName := sDirName +'\';
iIndex := Self.FItems.IndexOf(sDirName);
if iIndex=-1 then Exit;
Result := FInArchive.ItemIsFolder[iIndex];
end;
function TD7zipFile.DoOnPassword(var sPassword: WideString): HRESULT;
var
bContinue: Boolean;
begin
bContinue := True;
if Assigned(FOnPassword) then FOnPassword(Self, sPassword, bContinue);
if bContinue then Result := S_OK else Result := S_FALSE;
end;
function TD7zipFile.DoOnProgress(bIsTotal: boolean;
iValue: Int64): HRESULT;
var
bContinue: Boolean;
begin
bContinue := True;
if Assigned(FOnProgress) then FOnProgress(Self, bIsTotal, iValue, bContinue);
if bContinue then Result := S_OK else Result := S_FALSE;
end;
function TD7zipFile.ExtractItemToFile(sFileName: WideString;
sToFile: WideString): Boolean;
var
AStream: TStream;
begin
AStream:=TFileStream.Create(sToFile, fmCreate);
try
Result := ExtractItemToStream(sFileName, AStream);
finally
AStream.Free;
end;
end;
function TD7zipFile.ExtractItemToStream(sFileName: WideString;
AStream: TStream): Boolean;
var
iIndex: Integer;
begin
Result := False;
if FInArchive=nil then Exit;
iIndex := FItems.IndexOf(sFileName);
if iIndex=-1 then Exit;
try
FInArchive.ExtractItem(iIndex, AStream, False);
Result := True;
except
end;
end;
function TD7zipFile.FileExists(sFileName: WideString): Boolean;
var
iIndex:Integer;
begin
Result := False;
if FInArchive=nil then Exit;
if sFileName<>'' then
if sFileName[Length(sFileName)]<>'\' then
sFileName := sFileName +'\';
iIndex := Self.FItems.IndexOf(sFileName);
if iIndex=-1 then Exit;
Result := not FInArchive.ItemIsFolder[iIndex];
end;
function TD7zipFile.GetCurrentDir: WideString;
begin
Result := FCurrentItemPath;
end;
function TD7zipFile.GetItems(sPath: WideString; iFilter: Integer=0): TD7zipStrings;
function IsItemChild(sParent, sChild: WideString):Boolean;
//var
// sTmp: WideString;
begin
if (sParent='') then //获取全部
Result := True
else if (sParent='\\') then //根目录
Result := Pos('\', sChild)=0
else
begin
Result := (Pos(sParent, sChild)=1) and
(Pos('\', Copy(sChild, Length(sParent)+1, Length(sChild)))=0);
end;
end;
var
I: Integer;
sTmp: WideString;
bDir: Boolean;
begin
Result := TD7zipStringList.Create;
if (sPath='.') then //当前目录
begin
sPath := FCurrentItemPath;
end
else if (sPath='..') then //上一层目录
begin
if (FCurrentItemPath='') then FCurrentItemPath := '\\';
if FCurrentItemPath<>'\\' then
begin
sPath := FCurrentItemPath;
if sPath[Length(sPath)]='\' then
sPath := Copy(sPath, 1, Length(sPath)-1);
sPath := ExtractFilePath(sPath);
end
else
sPath := FCurrentItemPath;
if (sPath='') then sPath := '\\';
end;
if sPath<>'' then
begin
if sPath[Length(sPath)]<>'\' then sPath := sPath +'\';
FCurrentItemPath := sPath;
end;
if (sPath<>'') and (sPath<>'\\') then
begin
Result.Add('.');
Result.Add('..');
end;
for I:=0 to FItems.Count-1 do
begin
bDir := False;
sTmp := FItems.Strings[I];
if sTmp<>'' then
if sTmp[Length(sTmp)]='\' then
begin
sTmp := Copy(sTmp, 1, Length(sTmp)-1);
bDir := True;
end;
if not IsItemChild(sPath, sTmp) then Continue;
if (iFilter=0)
or ((iFilter=1) and (not bDir))
or ((iFilter=2) and (bDir)) then
Result.Add(sTmp);
end;
end;
function TD7zipFile.LoadFromFile(AFileName: WideString): Boolean;
function FileExtToFileTypes(sExt: WideString): TD7zFileTypes;
begin
Result := [];
if (sExt='.ZIP') or (sExt='.JAR') or (sExt='.XPI') then
Include(Result, dftZip)
else if (sExt='.BZ2') or (sExt='.BZIP2') or (sExt='.TBZ2') or (sExt='.TBZ') then
Include(Result, dftBZ2)
else if (sExt='.RAR') or (sExt='.R00') then
Include(Result, dftRar)
else if (sExt='.ARJ') then
Include(Result, dftArj)
else if (sExt='.Z') or (sExt='.TAZ') then
Include(Result, dftZ)
else if (sExt='.LZH') or (sExt='.LHA') then
Include(Result, dftLzh)
else if (sExt='.7Z') then
Include(Result, dft7z)
else if (sExt='.CAB') then
Include(Result, dftCab)
else if (sExt='.NSIS') then
Include(Result, dftNsis) //安装包工具
else if (sExt='.LZMA') or (sExt='.LZMA86') then
Include(Result, dftLzma)
else if (sExt='.EXE') then
begin
Include(Result, dftPe);
Include(Result, dftNsis);
end
else if (sExt='.PE') or (sExt='.DLL') or (sExt='.SYS') then
Include(Result, dftPe)
else if (sExt='.ELF') then
Include(Result, dftElf)
else if (sExt='.MACHO') then
Include(Result, dftMacho)
else if (sExt='.UDF') then
Include(Result, dftUdf)
else if (sExt='.XAR') then
Include(Result, dftXar)
else if (sExt='.MUB') then
Include(Result, dftMub)
else if (sExt='.HFS') or (sExt='.CD') then
Include(Result, dftHfs)
else if (sExt='.DMG') then
Include(Result, dftDmg)
else if (sExt='.MSI') or (sExt='.DOC') or (sExt='.XLS') or (sExt='.PPT') then
Include(Result, dftCompound)
else if (sExt='.WIM') or (sExt='.SWM') then
Include(Result, dftWim)
else if (sExt='.ISO') then
begin
Include(Result, dftIso);
Include(Result, dftUdf);
end
else if (sExt='.BKF') then
Include(Result, dftBkf)
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
Include(Result, dftChm)
else if (sExt='.001') then
Include(Result, dftSplit)
else if (sExt='.RPM') then
Include(Result, dftRpm)
else if (sExt='.DEB') then
Include(Result, dftDeb)
else if (sExt='.CPIO') then
Include(Result, dftCpio)
else if (sExt='.TAR') then
Include(Result, dftTar)
else if (sExt='.GZ') or (sExt='.GZIP') or (sExt='.TGZ') or (sExt='.TPZ') then
Include(Result, dftGZip);
end;
begin
Result := False;
FreeAndNil(FTmpStream);
FTmpStream:=TFileStream.Create(AFileName, fmOpenRead);
try
Result := LoadFromStream(FTmpStream, FileExtToFileTypes(UpperCase(ExtractFileExt(AFileName))));
finally
if not Result then FreeAndNil(FTmpStream);
end;
end;
function TD7zipFile.LoadFromStream(AStream: TStream; AFileTypes: TD7zFileTypes=[]): Boolean;
var
bUnknowType:Boolean;
AFileType: TD7zFileType;
begin
FInArchive := nil;
Result := False;
try
bUnknowType := AFileTypes=[];
AFileType := Low(TD7zFileType);
while AFileType<High(TD7zFileType) do
begin
if (not Result) and (bUnknowType or (AFileType in AFileTypes)) then
Result := LoadFromStream(AStream, AFileType);
if Result then Break;
Inc(AFileType);
end;
(*
if (not Result) and (bUnknowType or (dftZip in AFileTypes)) then
Result := LoadFromStream(AStream, dftZip);
if (not Result) and (bUnknowType or (dftBZ2 in AFileTypes)) then
Result := LoadFromStream(AStream, dftBZ2);
if (not Result) and (bUnknowType or (dftRar in AFileTypes)) then
Result := LoadFromStream(AStream, dftRar);
if (not Result) and (bUnknowType or (dftArj in AFileTypes)) then
Result := LoadFromStream(AStream, dftArj);
if (not Result) and (bUnknowType or (dftZ in AFileTypes)) then
Result := LoadFromStream(AStream, dftZ);
if (not Result) and (bUnknowType or (dftLzh in AFileTypes)) then
Result := LoadFromStream(AStream, dftLzh);
if (not Result) and (bUnknowType or (dft7z in AFileTypes)) then
Result := LoadFromStream(AStream, dft7z);
if (not Result) and (bUnknowType or (dftCab in AFileTypes)) then
Result := LoadFromStream(AStream, dftCab);
if (not Result) and (bUnknowType or (dftNsis in AFileTypes)) then
Result := LoadFromStream(AStream, dftNsis);
if (not Result) and (bUnknowType or (dftLzma in AFileTypes)) then
Result := LoadFromStream(AStream, dftLzma);
if (not Result) and (bUnknowType or (dftPe in AFileTypes)) then
Result := LoadFromStream(AStream, dftPe);
if (not Result) and (bUnknowType or (dftElf in AFileTypes)) then
Result := LoadFromStream(AStream, dftElf);
if (not Result) and (bUnknowType or (dftMacho in AFileTypes)) then
Result := LoadFromStream(AStream, dftMacho);
if (not Result) and (bUnknowType or (dftUdf in AFileTypes)) then
Result := LoadFromStream(AStream, dftUdf);
if (not Result) and (bUnknowType or (dftXar in AFileTypes)) then
Result := LoadFromStream(AStream, dftXar);
if (not Result) and (bUnknowType or (dftMub in AFileTypes)) then
Result := LoadFromStream(AStream, dftMub);
if (not Result) and (bUnknowType or (dftHfs in AFileTypes)) then
Result := LoadFromStream(AStream, dftHfs);
if (not Result) and (bUnknowType or (dftDmg in AFileTypes)) then
Result := LoadFromStream(AStream, dftDmg);
if (not Result) and (bUnknowType or (dftCompound in AFileTypes)) then
Result := LoadFromStream(AStream, dftCompound);
if (not Result) and (bUnknowType or (dftWim in AFileTypes)) then
Result := LoadFromStream(AStream, dftWim);
if (not Result) and (bUnknowType or (dftIso in AFileTypes)) then
Result := LoadFromStream(AStream, dftIso);
if (not Result) and (bUnknowType or (dftBkf in AFileTypes)) then
Result := LoadFromStream(AStream, dftBkf);
if (not Result) and (bUnknowType or (dftChm in AFileTypes)) then
Result := LoadFromStream(AStream, dftChm);
if (not Result) and (bUnknowType or (dftSplit in AFileTypes)) then
Result := LoadFromStream(AStream, dftSplit);
if (not Result) and (bUnknowType or (dftRpm in AFileTypes)) then
Result := LoadFromStream(AStream, dftRpm);
if (not Result) and (bUnknowType or (dftDeb in AFileTypes)) then
Result := LoadFromStream(AStream, dftDeb);
if (not Result) and (bUnknowType or (dftCpio in AFileTypes)) then
Result := LoadFromStream(AStream, dftCpio);
if (not Result) and (bUnknowType or (dftTar in AFileTypes)) then
Result := LoadFromStream(AStream, dftTar);
if (not Result) and (bUnknowType or (dftGZip in AFileTypes)) then
Result := LoadFromStream(AStream, dftGZip);
*)
except
FInArchive := nil;
end;
end;
function TD7zipFile.LoadFromStream(AStream: TStream;
AFileType: TD7zFileType): Boolean;
var
iIndex, I: Integer;
zStream: IInStream;//T7zStream;
sTmp, sTmpDir: WideString;
iPos: Int64;
sTmpDirListAdd, sTmpDirList: TD7zipStrings;
begin
Result := False;
FInArchive := nil;
FCurrentItemPath := '\\';
FItems.Clear;
iPos := AStream.Position;
case AFileType of
dftZip : FInArchive:= CreateInArchive(CLSID_CFormatZip);
dftBZ2 : FInArchive:= CreateInArchive(CLSID_CFormatBZ2);
dftRar : FInArchive:= CreateInArchive(CLSID_CFormatRar);
dftArj : FInArchive:= CreateInArchive(CLSID_CFormatArj);
dftZ : FInArchive:= CreateInArchive(CLSID_CFormatZ);
dftLzh : FInArchive:= CreateInArchive(CLSID_CFormatLzh);
dft7z : FInArchive:= CreateInArchive(CLSID_CFormat7z);
dftCab : FInArchive:= CreateInArchive(CLSID_CFormatCab);
dftNsis : FInArchive:= CreateInArchive(CLSID_CFormatNsis);
dftLzma : FInArchive:= CreateInArchive(CLSID_CFormatLzma);
dftPe : FInArchive:= CreateInArchive(CLSID_CFormatPe);
dftElf : FInArchive:= CreateInArchive(CLSID_CFormatElf);
dftMacho : FInArchive:= CreateInArchive(CLSID_CFormatMacho);
dftUdf : FInArchive:= CreateInArchive(CLSID_CFormatUdf);
dftXar : FInArchive:= CreateInArchive(CLSID_CFormatXar);
dftMub : FInArchive:= CreateInArchive(CLSID_CFormatMub);
dftHfs : FInArchive:= CreateInArchive(CLSID_CFormatHfs);
dftDmg : FInArchive:= CreateInArchive(CLSID_CFormatDmg);
dftCompound : FInArchive:= CreateInArchive(CLSID_CFormatCompound);
dftWim : FInArchive:= CreateInArchive(CLSID_CFormatWim);
dftIso : FInArchive:= CreateInArchive(CLSID_CFormatIso);
dftBkf : FInArchive:= CreateInArchive(CLSID_CFormatBkf);
dftChm : FInArchive:= CreateInArchive(CLSID_CFormatChm);
dftSplit : FInArchive:= CreateInArchive(CLSID_CFormatSplit);
dftRpm : FInArchive:= CreateInArchive(CLSID_CFormatRpm);
dftDeb : FInArchive:= CreateInArchive(CLSID_CFormatDeb);
dftCpio : FInArchive:= CreateInArchive(CLSID_CFormatCpio);
dftTar : FInArchive:= CreateInArchive(CLSID_CFormatTar);
dftGZip : FInArchive:= CreateInArchive(CLSID_CFormatGZip);
else
Exit;
end;
zStream := T7zStream.Create(AStream);
try
FInArchive.OpenStream(zStream);
FInArchive.SetPasswordCallback(Self, FPasswordCallback);
FInArchive.SetProgressCallback(Self, FProgressCallback);
sTmpDirListAdd := TD7zipStringList.Create;
sTmpDirList := TD7zipStringList.Create;
try
for I:=0 to FInArchive.NumberOfItems-1 do
begin
sTmp := FInArchive.ItemPath[I];
if FInArchive.ItemIsFolder[I] then
begin
if (sTmp<>'') and (sTmp[Length(sTmp)]<>'\') then
sTmp := sTmp+'\';
if sTmpDirList.IndexOf(sTmp)=-1 then
sTmpDirList.Add(sTmp);
//else //已添加到临时列表则需要删除
begin
iIndex := sTmpDirListAdd.IndexOf(sTmp);
if iIndex>-1 then
sTmpDirListAdd.Delete(iIndex);
end;
end
else
begin
sTmpDir := ExtractFilePath(sTmp);
if sTmpDirList.IndexOf(sTmpDir)=-1 then
begin //未添加的文件夹需要添加到临时列表里
if sTmpDirListAdd.IndexOf(sTmpDir)=-1 then
sTmpDirListAdd.Add(sTmpDir);
end;
end;
FItems.Add(sTmp);
end;
FItems.AddStrings(sTmpDirListAdd);
finally
sTmpDirList.Free;
sTmpDirListAdd.Free;
zStream := nil;
end;
Result := True;
except
zStream := nil;
FInArchive := nil;
AStream.Position := iPos;
end;
end;
{ TD7zipStringList }
constructor TD7zipStringList.Create;
begin
Self.CaseSensitive := False;//忽略大小写
end;
end.2、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:hgourvest@gmail.com">hgourvest@gmail.com</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
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.二、将 7z.dll 放到程序运行目录
https://download.csdn.net/download/qq_33397419/86401066
三、使用方法
uses
D7zUtils, SevenZip;
//-------------------------------------------------------------
//【解压文件】
procedure TForm1.btn1Click(Sender: TObject);
begin
with CreateInArchive(CLSID_CFormatZip) do
begin
//将1.zip中文件解压到C盘根目录
OpenFile('c:\1.zip');
ExtractTo('c:\');
end;
end;
//-------------------------------------------------------------
//【压缩文件】
procedure TForm1.btn2Click(Sender: TObject);
begin
with CreateOutArchive(CLSID_CFormatZip) do
begin
//将1.txt中文件压缩到1.zip
AddFile('c:\1.txt','1.txt');
SaveToFile('c:\1.zip')
end;
end;路过的点个赞再走，谢谢~😊😊😊😀😀😀
扫一扫
6498
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
