Delphi压缩解压文件，无需第三方控件
2024-06-30 04:27:50
一、首先引入两个写好的单元：
1、D7zUtils.pas
unit D7zUtils;interface
usesSysUtils, Classes, Sevenzip;typeTD7zFileType = (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)publicconstructor 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 = classprivateFInArchive: I7zInArchive;FItems: TD7zipStrings;FTmpStream: TStream;privateFCurrentItemPath: WideString;FOnPassword: TOnPassword;FOnProgress: TOnProgress;privateFPasswordCallback: T7zPasswordCallback;FProgressCallback: T7zProgressCallback;function DoOnPassword(var sPassword: WideString): HRESULT;function DoOnProgress(bIsTotal: boolean; iValue: Int64): HRESULT;publicconstructor 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;publicfunction GetItems(sPath: WideString; iFilter: Integer=0): TD7zipStrings;//iFilter： 0-All 1-File 2 Dir ; sPath-暂不支持通配符publicfunction ExtractItemToStream(sFileName: WideString; AStream: TStream):Boolean; //解压/获取单个文件function ExtractItemToFile(sFileName: WideString; sToFile: WideString):Boolean;//解压/获取单个文件publicproperty CurrentItemPath: WideString read FCurrentItemPath;public//fileSystem functionsfunction FileExists(sFileName: WideString):Boolean;function DirectoryExists(sDirName: WideString):Boolean;function GetCurrentDir(): WideString;publicproperty OnPassword: TOnPassword read FOnPassword write FOnPassword;property OnProgress: TOnProgress read FOnProgress write FOnProgress;end;implementationfunction 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;
beginResult := S_FALSE;if sender=nil then Exit;Result := TD7zipFile(sender).DoOnProgress(total, value);
end;{ TD7zipFile }constructor TD7zipFile.Create;
beginFItems:=TD7zipStringList.Create;FPasswordCallback := FUNC_PasswordCallback;FProgressCallback := FUNC_ProgressCallback;
end;destructor TD7zipFile.Destroy;
beginFItems.Free;FreeAndNil(FTmpStream);inherited;
end;function TD7zipFile.DirectoryExists(sDirName: WideString): Boolean;
variIndex:Integer;
beginResult := False;if FInArchive=nil then Exit;if sDirName<>'' thenif sDirName[Length(sDirName)]<>'\' thensDirName := sDirName +'\';iIndex := Self.FItems.IndexOf(sDirName);if iIndex=-1 then Exit;Result := FInArchive.ItemIsFolder[iIndex];
end;function TD7zipFile.DoOnPassword(var sPassword: WideString): HRESULT;
varbContinue: Boolean;
beginbContinue := 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;
varbContinue: Boolean;
beginbContinue := 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;
varAStream: TStream;
beginAStream:=TFileStream.Create(sToFile, fmCreate);tryResult := ExtractItemToStream(sFileName, AStream);finallyAStream.Free;end;
end;function TD7zipFile.ExtractItemToStream(sFileName: WideString;AStream: TStream): Boolean;
variIndex: Integer;
beginResult := False;if FInArchive=nil then Exit;iIndex := FItems.IndexOf(sFileName);if iIndex=-1 then Exit;tryFInArchive.ExtractItem(iIndex, AStream, False);Result := True;exceptend;
end;function TD7zipFile.FileExists(sFileName: WideString): Boolean;
variIndex:Integer;
beginResult := False;if FInArchive=nil then Exit;if sFileName<>'' thenif sFileName[Length(sFileName)]<>'\' thensFileName := sFileName +'\';iIndex := Self.FItems.IndexOf(sFileName);if iIndex=-1 then Exit;Result := not FInArchive.ItemIsFolder[iIndex];
end;function TD7zipFile.GetCurrentDir: WideString;
beginResult := FCurrentItemPath;
end;function TD7zipFile.GetItems(sPath: WideString; iFilter: Integer=0): TD7zipStrings;function IsItemChild(sParent, sChild: WideString):Boolean;//var// sTmp: WideString;beginif (sParent='') then //获取全部Result := Trueelse if (sParent='\\') then //根目录Result := Pos('\', sChild)=0elsebeginResult := (Pos(sParent, sChild)=1) and(Pos('\', Copy(sChild, Length(sParent)+1, Length(sChild)))=0);end;end;
varI: Integer;sTmp: WideString;bDir: Boolean;
beginResult := TD7zipStringList.Create;if (sPath='.') then //当前目录beginsPath := FCurrentItemPath;endelse if (sPath='..') then //上一层目录beginif (FCurrentItemPath='') then FCurrentItemPath := '\\';if FCurrentItemPath<>'\\' thenbeginsPath := FCurrentItemPath;if sPath[Length(sPath)]='\' thensPath := Copy(sPath, 1, Length(sPath)-1);sPath := ExtractFilePath(sPath);endelsesPath := FCurrentItemPath;if (sPath='') then sPath := '\\';end;if sPath<>'' thenbeginif sPath[Length(sPath)]<>'\' then sPath := sPath +'\';FCurrentItemPath := sPath;end;if (sPath<>'') and (sPath<>'\\') thenbeginResult.Add('.');Result.Add('..');end; for I:=0 to FItems.Count-1 dobeginbDir := False;sTmp := FItems.Strings[I];if sTmp<>'' thenif sTmp[Length(sTmp)]='\' thenbeginsTmp := 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)) thenResult.Add(sTmp);end;
end;function TD7zipFile.LoadFromFile(AFileName: WideString): Boolean;function FileExtToFileTypes(sExt: WideString): TD7zFileTypes;beginResult := [];if (sExt='.ZIP') or (sExt='.JAR') or (sExt='.XPI') thenInclude(Result, dftZip)else if (sExt='.BZ2') or (sExt='.BZIP2') or (sExt='.TBZ2') or (sExt='.TBZ') thenInclude(Result, dftBZ2)else if (sExt='.RAR') or (sExt='.R00') thenInclude(Result, dftRar)else if (sExt='.ARJ') thenInclude(Result, dftArj)else if (sExt='.Z') or (sExt='.TAZ') thenInclude(Result, dftZ)else if (sExt='.LZH') or (sExt='.LHA') thenInclude(Result, dftLzh)else if (sExt='.7Z') thenInclude(Result, dft7z)else if (sExt='.CAB') thenInclude(Result, dftCab)else if (sExt='.NSIS') thenInclude(Result, dftNsis) //安装包工具else if (sExt='.LZMA') or (sExt='.LZMA86') thenInclude(Result, dftLzma)else if (sExt='.EXE') thenbeginInclude(Result, dftPe);Include(Result, dftNsis);endelse if (sExt='.PE') or (sExt='.DLL') or (sExt='.SYS') thenInclude(Result, dftPe)else if (sExt='.ELF') thenInclude(Result, dftElf)else if (sExt='.MACHO') thenInclude(Result, dftMacho)else if (sExt='.UDF') thenInclude(Result, dftUdf)else if (sExt='.XAR') thenInclude(Result, dftXar)else if (sExt='.MUB') thenInclude(Result, dftMub)else if (sExt='.HFS') or (sExt='.CD') thenInclude(Result, dftHfs)else if (sExt='.DMG') thenInclude(Result, dftDmg)else if (sExt='.MSI') or (sExt='.DOC') or (sExt='.XLS') or (sExt='.PPT') thenInclude(Result, dftCompound)else if (sExt='.WIM') or (sExt='.SWM') thenInclude(Result, dftWim)else if (sExt='.ISO') thenbeginInclude(Result, dftIso);Include(Result, dftUdf);endelse if (sExt='.BKF') thenInclude(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') thenInclude(Result, dftChm)else if (sExt='.001') thenInclude(Result, dftSplit)else if (sExt='.RPM') thenInclude(Result, dftRpm)else if (sExt='.DEB') thenInclude(Result, dftDeb)else if (sExt='.CPIO') thenInclude(Result, dftCpio)else if (sExt='.TAR') thenInclude(Result, dftTar)else if (sExt='.GZ') or (sExt='.GZIP') or (sExt='.TGZ') or (sExt='.TPZ') thenInclude(Result, dftGZip);end;
beginResult := False;FreeAndNil(FTmpStream);FTmpStream:=TFileStream.Create(AFileName, fmOpenRead);tryResult := LoadFromStream(FTmpStream, FileExtToFileTypes(UpperCase(ExtractFileExt(AFileName))));finallyif not Result then FreeAndNil(FTmpStream);end;
end;function TD7zipFile.LoadFromStream(AStream: TStream; AFileTypes: TD7zFileTypes=[]): Boolean;
varbUnknowType:Boolean;AFileType: TD7zFileType;
beginFInArchive := nil;Result := False;trybUnknowType := AFileTypes=[];AFileType := Low(TD7zFileType);while AFileType<High(TD7zFileType) dobeginif (not Result) and (bUnknowType or (AFileType in AFileTypes)) thenResult := LoadFromStream(AStream, AFileType);if Result then Break;Inc(AFileType);end;(*if (not Result) and (bUnknowType or (dftZip in AFileTypes)) thenResult := LoadFromStream(AStream, dftZip);if (not Result) and (bUnknowType or (dftBZ2 in AFileTypes)) thenResult := LoadFromStream(AStream, dftBZ2);if (not Result) and (bUnknowType or (dftRar in AFileTypes)) thenResult := LoadFromStream(AStream, dftRar);if (not Result) and (bUnknowType or (dftArj in AFileTypes)) thenResult := LoadFromStream(AStream, dftArj);if (not Result) and (bUnknowType or (dftZ in AFileTypes)) thenResult := LoadFromStream(AStream, dftZ);if (not Result) and (bUnknowType or (dftLzh in AFileTypes)) thenResult := LoadFromStream(AStream, dftLzh);if (not Result) and (bUnknowType or (dft7z in AFileTypes)) thenResult := LoadFromStream(AStream, dft7z);if (not Result) and (bUnknowType or (dftCab in AFileTypes)) thenResult := LoadFromStream(AStream, dftCab);if (not Result) and (bUnknowType or (dftNsis in AFileTypes)) thenResult := LoadFromStream(AStream, dftNsis);if (not Result) and (bUnknowType or (dftLzma in AFileTypes)) thenResult := LoadFromStream(AStream, dftLzma);if (not Result) and (bUnknowType or (dftPe in AFileTypes)) thenResult := LoadFromStream(AStream, dftPe);if (not Result) and (bUnknowType or (dftElf in AFileTypes)) thenResult := LoadFromStream(AStream, dftElf);if (not Result) and (bUnknowType or (dftMacho in AFileTypes)) thenResult := LoadFromStream(AStream, dftMacho);if (not Result) and (bUnknowType or (dftUdf in AFileTypes)) thenResult := LoadFromStream(AStream, dftUdf);if (not Result) and (bUnknowType or (dftXar in AFileTypes)) thenResult := LoadFromStream(AStream, dftXar);if (not Result) and (bUnknowType or (dftMub in AFileTypes)) thenResult := LoadFromStream(AStream, dftMub);if (not Result) and (bUnknowType or (dftHfs in AFileTypes)) thenResult := LoadFromStream(AStream, dftHfs);if (not Result) and (bUnknowType or (dftDmg in AFileTypes)) thenResult := LoadFromStream(AStream, dftDmg);if (not Result) and (bUnknowType or (dftCompound in AFileTypes)) thenResult := LoadFromStream(AStream, dftCompound);if (not Result) and (bUnknowType or (dftWim in AFileTypes)) thenResult := LoadFromStream(AStream, dftWim);if (not Result) and (bUnknowType or (dftIso in AFileTypes)) thenResult := LoadFromStream(AStream, dftIso);if (not Result) and (bUnknowType or (dftBkf in AFileTypes)) thenResult := LoadFromStream(AStream, dftBkf);if (not Result) and (bUnknowType or (dftChm in AFileTypes)) thenResult := LoadFromStream(AStream, dftChm);if (not Result) and (bUnknowType or (dftSplit in AFileTypes)) thenResult := LoadFromStream(AStream, dftSplit);if (not Result) and (bUnknowType or (dftRpm in AFileTypes)) thenResult := LoadFromStream(AStream, dftRpm);if (not Result) and (bUnknowType or (dftDeb in AFileTypes)) thenResult := LoadFromStream(AStream, dftDeb);if (not Result) and (bUnknowType or (dftCpio in AFileTypes)) thenResult := LoadFromStream(AStream, dftCpio);if (not Result) and (bUnknowType or (dftTar in AFileTypes)) thenResult := LoadFromStream(AStream, dftTar);if (not Result) and (bUnknowType or (dftGZip in AFileTypes)) thenResult := LoadFromStream(AStream, dftGZip);*)exceptFInArchive := nil;end;
end;function TD7zipFile.LoadFromStream(AStream: TStream;AFileType: TD7zFileType): Boolean;
variIndex, I: Integer;zStream: IInStream;//T7zStream;sTmp, sTmpDir: WideString;iPos: Int64;sTmpDirListAdd, sTmpDirList: TD7zipStrings;
beginResult := False;FInArchive := nil;FCurrentItemPath := '\\';FItems.Clear;iPos := AStream.Position;case AFileType ofdftZip : 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);elseExit;end;zStream := T7zStream.Create(AStream);tryFInArchive.OpenStream(zStream);FInArchive.SetPasswordCallback(Self, FPasswordCallback);FInArchive.SetProgressCallback(Self, FProgressCallback);sTmpDirListAdd := TD7zipStringList.Create;sTmpDirList := TD7zipStringList.Create;tryfor I:=0 to FInArchive.NumberOfItems-1 dobeginsTmp := FInArchive.ItemPath[I];if FInArchive.ItemIsFolder[I] thenbeginif (sTmp<>'') and (sTmp[Length(sTmp)]<>'\') thensTmp := sTmp+'\';if sTmpDirList.IndexOf(sTmp)=-1 thensTmpDirList.Add(sTmp);//else //已添加到临时列表则需要删除beginiIndex := sTmpDirListAdd.IndexOf(sTmp);if iIndex>-1 thensTmpDirListAdd.Delete(iIndex);end;endelsebeginsTmpDir := ExtractFilePath(sTmp);if sTmpDirList.IndexOf(sTmpDir)=-1 thenbegin //未添加的文件夹需要添加到临时列表里if sTmpDirListAdd.IndexOf(sTmpDir)=-1 thensTmpDirListAdd.Add(sTmpDir);end;end;FItems.Add(sTmp);end;FItems.AddStrings(sTmpDirListAdd);finallysTmpDirList.Free;sTmpDirListAdd.Free;zStream := nil;end;Result := True;exceptzStream := nil;FInArchive := nil;AStream.Position := iPos;end;
end;{ TD7zipStringList }constructor TD7zipStringList.Create;
beginSelf.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}interfaceuses SysUtils, Windows, ActiveX, Classes, Contnrs;typePVarType = ^TVarType;PCardArray = ^TCardArray;TCardArray = array [0 .. MaxInt div SizeOf(Cardinal) - 1] of Cardinal;
{$IFNDEF UNICODE}UnicodeString = WideString;
{$ENDIF}// ******************************************************************************// PropID.h// ******************************************************************************
constkpidNoProperty = 0;kpidHandlerItemIndex = 2;kpidPath = 3; // VT_BSTRkpidName = 4; // VT_BSTRkpidExtension = 5; // VT_BSTRkpidIsFolder = 6; // VT_BOOLkpidSize = 7; // VT_UI8kpidPackedSize = 8; // VT_UI8kpidAttributes = 9; // VT_UI4kpidCreationTime = 10; // VT_FILETIMEkpidLastAccessTime = 11; // VT_FILETIMEkpidLastWriteTime = 12; // VT_FILETIMEkpidSolid = 13; // VT_BOOLkpidCommented = 14; // VT_BOOLkpidEncrypted = 15; // VT_BOOLkpidSplitBefore = 16; // VT_BOOLkpidSplitAfter = 17; // VT_BOOLkpidDictionarySize = 18; // VT_UI4kpidCRC = 19; // VT_UI4kpidType = 20; // VT_BSTRkpidIsAnti = 21; // VT_BOOLkpidMethod = 22; // VT_BSTRkpidHostOS = 23; // VT_BSTRkpidFileSystem = 24; // VT_BSTRkpidUser = 25; // VT_BSTRkpidGroup = 26; // VT_BSTRkpidBlock = 27; // VT_UI4kpidComment = 28; // VT_BSTRkpidPosition = 29; // VT_UI4kpidPrefix = 30; // VT_BSTRkpidNumSubDirs = 31; // VT_UI4kpidNumSubFiles = 32; // VT_UI4kpidUnpackVer = 33; // VT_UI1kpidVolume = 34; // VT_UI4kpidIsVolume = 35; // VT_BOOLkpidOffset = 36; // VT_UI8kpidLinks = 37; // VT_UI4kpidNumBlocks = 38; // VT_UI4kpidNumVolumes = 39; // VT_UI4kpidTimeType = 40; // VT_UI4kpidBit64 = 41; // VT_BOOLkpidBigEndian = 42; // VT_BOOLkpidCpu = 43; // VT_BSTRkpidPhySize = 44; // VT_UI8kpidHeadersSize = 45; // VT_UI8kpidChecksum = 46; // VT_UI4kpidCharacts = 47; // VT_BSTRkpidVa = 48; // VT_UI8kpidTotalSize = $1100; // VT_UI8kpidFreeSpace = kpidTotalSize + 1; // VT_UI8kpidClusterSize = kpidFreeSpace + 1; // VT_UI8kpidVolumeName = kpidClusterSize + 1; // VT_BSTRkpidLocalName = $1200; // VT_BSTRkpidProvider = kpidLocalName + 1; // VT_BSTRkpidUserDefined = $10000;// ******************************************************************************// IProgress.h// ******************************************************************************
typeIProgress = 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// NFileTimeTypeNFileTimeType = (kWindows = 0, kUnix, kDOS);// NArchive::NArchive = (kName = 0, // stringkClassID, // GUIDkExtension, // string zip rar gzkAddExtension, // sub archive: tarkUpdate, // boolkKeepName, // boolkStartSignature, // string[4] ex: PK.. 7z.. Rar!kFinishSignature, kAssociate);// NArchive::NExtract::NAskModeNAskMode = (kExtract = 0, kTest, kSkip);// NArchive::NExtract::NOperationResultNExtOperationResult = (kOK = 0, kUnSupportedMethod, kDataError, kCRCError);// NArchive::NUpdate::NOperationResultNUpdOperationResult = (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 filefunction 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 datanewProperties: PInteger; // 1 - new properties, 0 - old propertiesindexInArchive: 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;typeICompressSetCoderProperties = 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)privateFStream: TStream;FOwnership: TStreamOwnership;protectedfunction 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;publicconstructor Create(stream: TStream;Ownership: TStreamOwnership = soReference);destructor Destroy; override;end;// I7zOutArchive property setters
typeTZipCompressionMethod = (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;constCLSID_CFormatZip: TGUID = '{23170F69-40C1-278A-1000-000110010000}';// zip jar xpiCLSID_CFormatBZ2: TGUID = '{23170F69-40C1-278A-1000-000110020000}';// bz2 bzip2 tbz2 tbzCLSID_CFormatRar: TGUID = '{23170F69-40C1-278A-1000-000110030000}'; // rar r00CLSID_CFormatArj: TGUID = '{23170F69-40C1-278A-1000-000110040000}'; // arjCLSID_CFormatZ: TGUID = '{23170F69-40C1-278A-1000-000110050000}'; // z tazCLSID_CFormatLzh: TGUID = '{23170F69-40C1-278A-1000-000110060000}'; // lzh lhaCLSID_CFormat7z: TGUID = '{23170F69-40C1-278A-1000-000110070000}'; // 7zCLSID_CFormatCab: TGUID = '{23170F69-40C1-278A-1000-000110080000}'; // cabCLSID_CFormatNsis: TGUID = '{23170F69-40C1-278A-1000-000110090000}';CLSID_CFormatLzma: TGUID = '{23170F69-40C1-278A-1000-0001100A0000}';// lzma lzma86CLSID_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}'; // isoCLSID_CFormatXar: TGUID = '{23170F69-40C1-278A-1000-000110E10000}'; // xarCLSID_CFormatMub: TGUID = '{23170F69-40C1-278A-1000-000110E20000}';CLSID_CFormatHfs: TGUID = '{23170F69-40C1-278A-1000-000110E30000}';CLSID_CFormatDmg: TGUID = '{23170F69-40C1-278A-1000-000110E40000}'; // dmgCLSID_CFormatCompound: TGUID = '{23170F69-40C1-278A-1000-000110E50000}';// msi doc xls pptCLSID_CFormatWim: TGUID = '{23170F69-40C1-278A-1000-000110E60000}'; // wim swmCLSID_CFormatIso: TGUID = '{23170F69-40C1-278A-1000-000110E70000}'; // isoCLSID_CFormatBkf: TGUID = '{23170F69-40C1-278A-1000-000110E80000}';CLSID_CFormatChm: TGUID = '{23170F69-40C1-278A-1000-000110E90000}';// chm chi chq chw hxs hxi hxr hxq hxw litCLSID_CFormatSplit: TGUID = '{23170F69-40C1-278A-1000-000110EA0000}'; // 001CLSID_CFormatRpm: TGUID = '{23170F69-40C1-278A-1000-000110EB0000}'; // rpmCLSID_CFormatDeb: TGUID = '{23170F69-40C1-278A-1000-000110EC0000}'; // debCLSID_CFormatCpio: TGUID = '{23170F69-40C1-278A-1000-000110ED0000}'; // cpioCLSID_CFormatTar: TGUID = '{23170F69-40C1-278A-1000-000110EE0000}'; // tarCLSID_CFormatGZip: TGUID = '{23170F69-40C1-278A-1000-000110EF0000}';// gz gzip tgz tpzimplementationconstMAXCHECK: 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;
varst: TSystemTime;
beginDateTimeToSystemTime(dt, st);if not(SystemTimeToFileTime(st, Result) and LocalFileTimeToFileTime(Result,Result)) thenRaiseLastOSError;
end;function FileTimeToDateTime(ft: TFileTime): TDateTime;
varst: TSystemTime;
beginif not(FileTimeToLocalFileTime(ft, ft) and FileTimeToSystemTime(ft, st)) thenRaiseLastOSError;Result := SystemTimeToDateTime(st);
end;function CurrentFileTime: TFileTime;
beginGetSystemTimeAsFileTime(Result);
end;procedure RINOK(const hr: HRESULT);
beginif hr <> S_OK thenraise Exception.Create(SysErrorMessage(hr));
end;procedure SetCardinalProperty(Arch: I7zOutArchive; const name: UnicodeString;card: Cardinal);
varvalue: OleVariant;
beginTPropVariant(value).vt := VT_UI4;TPropVariant(value).ulVal := card;Arch.SetPropertie(name, value);
end;procedure SetBooleanProperty(Arch: I7zOutArchive; const name: UnicodeString;bool: boolean);
begincase bool oftrue:Arch.SetPropertie(name, 'ON');false:Arch.SetPropertie(name, 'OFF');end;
end;procedure SetCompressionLevel(Arch: I7zOutArchive; level: Cardinal);
beginSetCardinalProperty(Arch, 'X', level);
end;procedure SetMultiThreading(Arch: I7zOutArchive; ThreadCount: Cardinal);
beginSetCardinalProperty(Arch, 'MT', ThreadCount);
end;procedure SetCompressionMethod(Arch: I7zOutArchive;method: TZipCompressionMethod);
beginArch.SetPropertie('M', ZipCompressionMethod[method]);
end;procedure SetDictionnarySize(Arch: I7zOutArchive; size: Cardinal);
beginSetCardinalProperty(Arch, 'D', size);
end;procedure SetDeflateNumPasses(Arch: I7zOutArchive; pass: Cardinal);
beginSetCardinalProperty(Arch, 'PASS', pass);
end;procedure SetNumFastBytes(Arch: I7zOutArchive; fb: Cardinal);
beginSetCardinalProperty(Arch, 'FB', fb);
end;procedure SetNumMatchFinderCycles(Arch: I7zOutArchive; mc: Cardinal);
beginSetCardinalProperty(Arch, 'MC', mc);
end;procedure SevenZipSetCompressionMethod(Arch: I7zOutArchive;method: T7zCompressionMethod);
beginArch.SetPropertie('0', SevCompressionMethod[method]);
end;procedure SevenZipSetBindInfo(Arch: I7zOutArchive; const bind: UnicodeString);
beginArch.SetPropertie('B', bind);
end;procedure SevenZipSetSolidSettings(Arch: I7zOutArchive; solid: boolean);
beginSetBooleanProperty(Arch, 'S', solid);
end;procedure SevenZipRemoveSfxBlock(Arch: I7zOutArchive; remove: boolean);
beginSetBooleanProperty(Arch, 'RSFX', remove);
end;procedure SevenZipAutoFilter(Arch: I7zOutArchive; auto: boolean);
beginSetBooleanProperty(Arch, 'F', auto);
end;procedure SevenZipCompressHeaders(Arch: I7zOutArchive; compress: boolean);
beginSetBooleanProperty(Arch, 'HC', compress);
end;procedure SevenZipCompressHeadersFull(Arch: I7zOutArchive; compress: boolean);
beginSetBooleanProperty(Arch, 'HCF', compress);
end;procedure SevenZipEncryptHeaders(Arch: I7zOutArchive; Encrypt: boolean);
beginSetBooleanProperty(Arch, 'HE', Encrypt);
end;procedure SevenZipVolumeMode(Arch: I7zOutArchive; Mode: boolean);
beginSetBooleanProperty(Arch, 'V', Mode);
end;typeT7zPlugin = class(TInterfacedObject)privateFHandle: THandle;FCreateObject: function(const clsid, iid: TGUID; var outObject): HRESULT; stdcall;publicconstructor Create(const lib: string); virtual;destructor Destroy; override;procedure CreateObject(const clsid, iid: TGUID; var obj);end;T7zCodec = class(T7zPlugin, I7zCodec, ICompressProgressInfo)privateFGetMethodProperty: 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;protectedfunction SetRatioInfo(inSize, outSize: PInt64): HRESULT; stdcall;publicfunction GetDecoder(const index: Integer): ICompressCoder;function GetEncoder(const index: Integer): ICompressCoder;constructor Create(const lib: string); override;property MethodProperty[index: Cardinal; propID: NMethodPropID]: OleVariantread GetMethodProperty;property NumberOfMethods: Cardinal read GetNumberOfMethods;property Name[const index: Integer]: string read GetName;end;T7zArchive = class(T7zPlugin)privateFGetHandlerProperty: function(propID: NArchive; var value: OleVariant): HRESULT; stdcall;FClassId: TGUID;procedure SetClassId(const classid: TGUID);function GetClassId: TGUID;publicfunction 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]: OleVariantread 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)privateFInArchive: 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// I7zInArchiveprocedure 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;// IArchiveOpenCallbackfunction SetTotal(files, bytes: PInt64): HRESULT; overload; stdcall;function SetCompleted(files, bytes: PInt64): HRESULT; overload; stdcall;// IProgressfunction SetTotal(total: Int64): HRESULT; overload; stdcall;function SetCompleted(completeValue: PInt64): HRESULT; overload; stdcall;// IArchiveExtractCallbackfunction GetStream(index: Cardinal; var outStream: ISequentialOutStream;askExtractMode: NAskMode): HRESULT; overload; stdcall;function PrepareOperation(askExtractMode: NAskMode): HRESULT; stdcall;function SetOperationResult(resultEOperationResult: NExtOperationResult): HRESULT; overload; stdcall;// ICryptoGetTextPasswordfunction CryptoGetTextPassword(var password: TBStr): HRESULT; stdcall;// IArchiveOpenVolumeCallbackfunction GetProperty(propID: propID; var value: OleVariant): HRESULT;overload; stdcall;function GetStream(const name: PWideChar; var inStream: IInStream): HRESULT;overload; stdcall;// IArchiveOpenSetSubArchiveNamefunction SetSubArchiveName(name: PWideChar): HRESULT; stdcall;publicconstructor Create(const lib: string); override;destructor Destroy; override;property InArchive: IInArchive read GetInArchive;end;T7zOutArchive = class(T7zArchive, I7zOutArchive, IArchiveUpdateCallback,ICryptoGetTextPassword2)privateFOutArchive: IOutArchive;FBatchList: TObjectList;FProgressCallback: T7zProgressCallback;FProgressSender: Pointer;FPassword: UnicodeString;function GetOutArchive: IOutArchive;protected// I7zOutArchiveprocedure 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;// IProgressfunction SetTotal(total: Int64): HRESULT; stdcall;function SetCompleted(completeValue: PInt64): HRESULT; stdcall;// IArchiveUpdateCallbackfunction GetUpdateItemInfo(index: Cardinal; newData: PInteger;// 1 - new data, 0 - old datanewProperties: PInteger; // 1 - new properties, 0 - old propertiesindexInArchive: 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;// ICryptoGetTextPassword2function CryptoGetTextPassword2(passwordIsDefined: PInteger;var password: TBStr): HRESULT; stdcall;publicconstructor Create(const lib: string); override;destructor Destroy; override;property OutArchive: IOutArchive read GetOutArchive;end;function CreateInArchive(const classid: TGUID): I7zInArchive;
beginResult := T7zInArchive.Create('7z.dll');Result.classid := classid;
end;function CreateInArchive(const filename: WideString): I7zInArchive;
varsExt: WideString;
beginResult := T7zInArchive.Create('7z.dll');sExt := UpperCase(ExtractFileExt(filename));if (sExt='.ZIP') or (sExt='.JAR') or (sExt='.XPI') thenResult.classid := CLSID_CFormatZipelse if (sExt='.BZ2') or (sExt='.BZIP2') or (sExt='.TBZ2') or (sExt='.TBZ') thenResult.classid := CLSID_CFormatBZ2else if (sExt='.RAR') or (sExt='.R00') thenResult.classid := CLSID_CFormatRarelse if (sExt='.ARJ') thenResult.classid := CLSID_CFormatArjelse if (sExt='.Z') or (sExt='.TAZ') thenResult.classid := CLSID_CFormatZelse if (sExt='.LZH') or (sExt='.LHA') thenResult.classid := CLSID_CFormatLzhelse if (sExt='.7Z') thenResult.classid := CLSID_CFormat7zelse if (sExt='.CAB') thenResult.classid := CLSID_CFormatCabelse if (sExt='.NSIS') thenResult.classid := CLSID_CFormatNsiselse if (sExt='.LZMA') or (sExt='.LZMA86') thenResult.classid := CLSID_CFormatLzmaelse if (sExt='.PE') or (sExt='.EXE') or (sExt='.DLL') or (sExt='.SYS') thenResult.classid := CLSID_CFormatPeelse if (sExt='.ELF') thenResult.classid := CLSID_CFormatElfelse if (sExt='.MACHO') thenResult.classid := CLSID_CFormatMachoelse if {(sExt='.ISO') or }(sExt='.UDF') thenResult.classid := CLSID_CFormatUdfelse if (sExt='.XAR') thenResult.classid := CLSID_CFormatXarelse if (sExt='.MUB') thenResult.classid := CLSID_CFormatMubelse if (sExt='.HGS') or (sExt='.CD') thenResult.classid := CLSID_CFormatHfselse if (sExt='.DMG') thenResult.classid := CLSID_CFormatDmgelse if (sExt='.MSI') or (sExt='.DOC') or (sExt='.XLS') or (sExt='.PPT') thenResult.classid := CLSID_CFormatCompoundelse if (sExt='.WIM') or (sExt='.SWM') thenResult.classid := CLSID_CFormatWimelse if (sExt='.ISO') thenResult.classid := CLSID_CFormatIsoelse if (sExt='.BKF') thenResult.classid := CLSID_CFormatBkfelse 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') thenResult.classid := CLSID_CFormatChmelse if (sExt='.001') thenResult.classid := CLSID_CFormatSplitelse if (sExt='.RPM') thenResult.classid := CLSID_CFormatRpmelse if (sExt='.DEB') thenResult.classid := CLSID_CFormatDebelse if (sExt='.CPIO') thenResult.classid := CLSID_CFormatCpioelse if (sExt='.TAR') thenResult.classid := CLSID_CFormatTarelse if (sExt='.GZ') or (sExt='.GZIP') or (sExt='.TGZ') or (sExt='.TPZ') thenResult.classid := CLSID_CFormatGZip;Result.OpenFile(filename);
end;function CreateOutArchive(const classid: TGUID): I7zOutArchive;
beginResult := T7zOutArchive.Create('7z.dll');Result.classid := classid;
end;{ T7zPlugin }
constructor T7zPlugin.Create(const lib: string);
beginFHandle := LoadLibrary(PChar(lib));if FHandle = 0 thenraise Exception.CreateFmt('Error loading library %s', [lib]);FCreateObject := GetProcAddress(FHandle, 'CreateObject');if not(Assigned(FCreateObject)) thenbeginFreeLibrary(FHandle);raise Exception.CreateFmt('%s is not a 7z library', [lib]);end;
end;destructor T7zPlugin.Destroy;
beginFreeLibrary(FHandle);inherited;
end;procedure T7zPlugin.CreateObject(const clsid, iid: TGUID; var obj);
varhr: HRESULT;
beginhr := FCreateObject(clsid, iid, obj);if failed(hr) thenraise Exception.Create(SysErrorMessage(hr));
end;{ T7zCodec }
constructor T7zCodec.Create(const lib: string);
begininherited;FGetMethodProperty := GetProcAddress(FHandle, 'GetMethodProperty');FGetNumberOfMethods := GetProcAddress(FHandle, 'GetNumberOfMethods');if not(Assigned(FGetMethodProperty) and Assigned(FGetNumberOfMethods)) thenbeginFreeLibrary(FHandle);raise Exception.CreateFmt('%s is not a codec library', [lib]);end;
end;function T7zCodec.GetDecoder(const index: Integer): ICompressCoder;
varv: OleVariant;
beginv := MethodProperty[index, kDecoder];CreateObject(TPropVariant(v).puuid^, ICompressCoder, Result);
end;function T7zCodec.GetEncoder(const index: Integer): ICompressCoder;
varv: OleVariant;
beginv := MethodProperty[index, kEncoder];CreateObject(TPropVariant(v).puuid^, ICompressCoder, Result);
end;function T7zCodec.GetMethodProperty(index: Cardinal; propID: NMethodPropID): OleVariant;
varhr: HRESULT;
beginhr := FGetMethodProperty(index, propID, Result);if failed(hr) thenraise Exception.Create(SysErrorMessage(hr));
end;function T7zCodec.GetName(const index: Integer): string;
beginResult := MethodProperty[index, kName_];
end;function T7zCodec.GetNumberOfMethods: Cardinal;
varhr: HRESULT;
beginhr := FGetNumberOfMethods(@Result);if failed(hr) thenraise Exception.Create(SysErrorMessage(hr));
end;function T7zCodec.SetRatioInfo(inSize, outSize: PInt64): HRESULT;
beginResult := S_OK;
end;{ T7zInArchive }
procedure T7zInArchive.Close; stdcall;
beginFPasswordIsDefined := false;FSubArchiveMode := false;FInArchive.Close;FInArchive := nil;
end;constructor T7zInArchive.Create(const lib: string);
begininherited;FPasswordCallback := nil;FPasswordSender := nil;FPasswordIsDefined := false;FSubArchiveMode := false;FExtractCallBack := nil;FExtractSender := nil;
end;destructor T7zInArchive.Destroy;
beginFInArchive := nil;inherited;
end;function T7zInArchive.GetInArchive: IInArchive;
beginif FInArchive = nil thenCreateObject(classid, IInArchive, FInArchive);Result := FInArchive;
end;function T7zInArchive.GetItemPath(const index: Integer): UnicodeString; stdcall;
beginResult := UnicodeString(GetItemProp(index, kpidPath));
end;function T7zInArchive.GetNumberOfItems: Cardinal; stdcall;
beginRINOK(FInArchive.GetNumberOfItems(Result));
end;procedure T7zInArchive.OpenFile(const filename: string); stdcall;
varstrm: IInStream;
beginstrm := T7zStream.Create(TFileStream.Create(filename, fmOpenRead orfmShareDenyNone), soOwned);tryRINOK(InArchive.Open(strm, @MAXCHECK, self as IArchiveOpenCallback));finallystrm := nil;end;
end;procedure T7zInArchive.OpenStream(stream: IInStream); stdcall;
beginRINOK(InArchive.Open(stream, @MAXCHECK, self as IArchiveOpenCallback));
end;function T7zInArchive.GetItemIsFolder(const index: Integer): boolean; stdcall;
beginResult := boolean(GetItemProp(index, kpidIsFolder));
end;function T7zInArchive.GetItemProp(const item: Cardinal; prop: propID): OleVariant;
beginFInArchive.GetProperty(item, prop, Result);
end;procedure T7zInArchive.ExtractItem(const item: Cardinal; stream: TStream;test: longbool); stdcall;
beginFStream := stream;tryif test thenRINOK(FInArchive.Extract(@item, 1, 1, self as IArchiveExtractCallback))elseRINOK(FInArchive.Extract(@item, 1, 0, self as IArchiveExtractCallback));finallyFStream := nil;end;
end;function T7zInArchive.GetStream(index: Cardinal;var outStream: ISequentialOutStream; askExtractMode: NAskMode): HRESULT;
varpath: string;
beginif askExtractMode = kExtract thenif FStream <> nil thenoutStream := T7zStream.Create(FStream, soReference)as ISequentialOutStreamelse if Assigned(FExtractCallBack) thenbeginResult := FExtractCallBack(FExtractSender, index, outStream);Exit;endelse if FExtractPath <> '' thenbeginif not GetItemIsFolder(index) thenbeginpath := 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;
beginResult := S_OK;
end;function T7zInArchive.SetCompleted(completeValue: PInt64): HRESULT;
beginif Assigned(FProgressCallback) and (completeValue <> nil) thenResult := FProgressCallback(FProgressSender, false, completeValue^)elseResult := S_OK;
end;function T7zInArchive.SetCompleted(files, bytes: PInt64): HRESULT;
beginResult := S_OK;
end;function T7zInArchive.SetOperationResult(resultEOperationResult: NExtOperationResult): HRESULT;
beginResult := S_OK;
end;function T7zInArchive.SetTotal(total: Int64): HRESULT;
beginif Assigned(FProgressCallback) thenResult := FProgressCallback(FProgressSender, true, total)elseResult := S_OK;
end;function T7zInArchive.SetTotal(files, bytes: PInt64): HRESULT;
beginResult := S_OK;
end;function T7zInArchive.CryptoGetTextPassword(var password: TBStr): HRESULT;
varwpass: UnicodeString;
beginif FPasswordIsDefined thenbeginpassword := SysAllocString(PWideChar(FPassword));Result := S_OK;endelse if Assigned(FPasswordCallback) thenbeginResult := FPasswordCallback(FPasswordSender, wpass);if Result = S_OK thenbeginpassword := SysAllocString(PWideChar(wpass));FPasswordIsDefined := true;FPassword := wpass;end;endelseResult := S_FALSE;
end;function T7zInArchive.GetProperty(propID: propID;var value: OleVariant): HRESULT;
beginResult := S_OK;
end;function T7zInArchive.GetStream(const name: PWideChar;var inStream: IInStream): HRESULT;
beginResult := S_OK;
end;procedure T7zInArchive.SetPasswordCallback(sender: Pointer;callback: T7zPasswordCallback); stdcall;
beginFPasswordSender := sender;FPasswordCallback := callback;
end;function T7zInArchive.SetSubArchiveName(name: PWideChar): HRESULT;
beginFSubArchiveMode := true;FSubArchiveName := name;Result := S_OK;
end;function T7zInArchive.GetItemName(const index: Integer): UnicodeString; stdcall;
beginResult := UnicodeString(GetItemProp(index, kpidName));
end;function T7zInArchive.GetItemSize(const index: Integer): Cardinal; stdcall;
beginResult := Cardinal(GetItemProp(index, kpidSize));
end;procedure T7zInArchive.ExtractItems(items: PCardArray; count: Cardinal;test: longbool; sender: Pointer; callback: T7zGetStreamCallBack); stdcall;
beginFExtractCallBack := callback;FExtractSender := sender;tryif test thenRINOK(FInArchive.Extract(items, count, 1,self as IArchiveExtractCallback))elseRINOK(FInArchive.Extract(items, count, 0,self as IArchiveExtractCallback));finallyFExtractCallBack := nil;FExtractSender := nil;end;
end;procedure T7zInArchive.SetProgressCallback(sender: Pointer;callback: T7zProgressCallback); stdcall;
beginFProgressSender := sender;FProgressCallback := callback;
end;procedure T7zInArchive.ExtractAll(test: longbool; sender: Pointer;callback: T7zGetStreamCallBack);
beginFExtractCallBack := callback;FExtractSender := sender;tryif test thenRINOK(FInArchive.Extract(nil, $FFFFFFFF, 1,self as IArchiveExtractCallback))elseRINOK(FInArchive.Extract(nil, $FFFFFFFF, 0,self as IArchiveExtractCallback));finallyFExtractCallBack := nil;FExtractSender := nil;end;
end;procedure T7zInArchive.ExtractTo(const path: string);
beginFExtractPath := IncludeTrailingPathDelimiter(path);tryRINOK(FInArchive.Extract(nil, $FFFFFFFF, 0,self as IArchiveExtractCallback));finallyFExtractPath := '';end;
end;procedure T7zInArchive.SetPassword(const password: UnicodeString);
beginFPassword := password;FPasswordIsDefined := FPassword <> '';
end;{ T7zArchive }
constructor T7zArchive.Create(const lib: string);
begininherited;FGetHandlerProperty := GetProcAddress(FHandle, 'GetHandlerProperty');if not Assigned(FGetHandlerProperty) thenbeginFreeLibrary(FHandle);raise Exception.CreateFmt('%s is not a Format library', [lib]);end;FClassId := GUID_NULL;
end;function T7zArchive.GetClassId: TGUID;
beginResult := FClassId;
end;function T7zArchive.GetHandlerProperty(const propID: NArchive): OleVariant;
varhr: HRESULT;
beginhr := FGetHandlerProperty(propID, Result);if failed(hr) thenraise Exception.Create(SysErrorMessage(hr));
end;function T7zArchive.GetLibGUIDProperty(const index: NArchive): TGUID;
varv: OleVariant;
beginv := HandlerProperty[index];Result := TPropVariant(v).puuid^;
end;function T7zArchive.GetLibStringProperty(const index: NArchive): string;
beginResult := HandlerProperty[Index];
end;procedure T7zArchive.SetClassId(const classid: TGUID);
beginFClassId := classid;
end;{ T7zStream }
constructor T7zStream.Create(stream: TStream; Ownership: TStreamOwnership);
begininherited Create;FStream := stream;FOwnership := Ownership;
end;destructor T7zStream.Destroy;
beginif FOwnership = soOwned thenbeginFStream.Free;FStream := nil;end;inherited;
end;function T7zStream.Flush: HRESULT;
beginResult := S_OK;
end;function T7zStream.GetSize(size: PInt64): HRESULT;
beginif size <> nil thensize^ := FStream.size;Result := S_OK;
end;function T7zStream.Read(data: Pointer; size: Cardinal;processedSize: PCardinal): HRESULT;
varlen: Integer;
beginlen := FStream.Read(data^, size);if processedSize <> nil thenprocessedSize^ := len;Result := S_OK;
end;function T7zStream.Seek(offset: Int64; seekOrigin: Cardinal;newPosition: PInt64): HRESULT;
beginFStream.Seek(offset, TSeekOrigin(seekOrigin));if newPosition <> nil thennewPosition^ := FStream.Position;Result := S_OK;
end;function T7zStream.SetSize(newSize: Int64): HRESULT;
beginFStream.size := newSize;Result := S_OK;
end;function T7zStream.Write(data: Pointer; size: Cardinal;processedSize: PCardinal): HRESULT;
varlen: Integer;
beginlen := FStream.Write(data^, size);if processedSize <> nil thenprocessedSize^ := len;Result := S_OK;
end;typeTSourceMode = (smStream, smFile);T7zBatchItem = classSourceMode: 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;
beginif (Ownership = soOwned) and (stream <> nil) thenstream.Free;inherited;
end;{ T7zOutArchive }
procedure T7zOutArchive.AddFile(const filename: TFileName;const path: UnicodeString);
varitem: T7zBatchItem;Handle: THandle;
beginif not FileExists(filename) thenExit;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);
varlencut: Integer;willlist: TStringList;zedir: string;procedure Traverse(p: string);varf: TSearchRec;i: Integer;item: T7zBatchItem;beginif recurse thenbeginif FindFirst(p + '*.*', faDirectory, f) = 0 thenrepeatif (f.name[1] <> '.') thenTraverse(IncludeTrailingPathDelimiter(p + f.name));until FindNext(f) <> 0;SysUtils.FindClose(f);end;for i := 0 to willlist.count - 1 dobeginif FindFirst(p + willlist[i], faReadOnly or faHidden or faSysFile orfaArchive, f) = 0 thenrepeatitem := 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 <> '' thenitem.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;beginwilllist := TStringList.Create;trywilllist.Delimiter := ';';willlist.DelimitedText := Willcards;zedir := IncludeTrailingPathDelimiter(Dir);lencut := length(zedir) + 1;Traverse(zedir);finallywilllist.Free;end;
end;procedure T7zOutArchive.AddStream(stream: TStream; Ownership: TStreamOwnership;Attributes: Cardinal; CreationTime, LastWriteTime: TFileTime;const path: UnicodeString; IsFolder, IsAnti: boolean); stdcall;
varitem: T7zBatchItem;
beginitem := 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;
beginFBatchList.Clear;
end;constructor T7zOutArchive.Create(const lib: string);
begininherited;FBatchList := TObjectList.Create;FProgressCallback := nil;FProgressSender := nil;
end;function T7zOutArchive.CryptoGetTextPassword2(passwordIsDefined: PInteger;var password: TBStr): HRESULT;
beginif FPassword <> '' thenbeginpasswordIsDefined^ := 1;password := SysAllocString(PWideChar(FPassword));endelsepasswordIsDefined^ := 0;Result := S_OK;
end;destructor T7zOutArchive.Destroy;
beginFOutArchive := nil;FBatchList.Free;inherited;
end;function T7zOutArchive.GetOutArchive: IOutArchive;
beginif FOutArchive = nil thenCreateObject(classid, IOutArchive, FOutArchive);Result := FOutArchive;
end;function T7zOutArchive.GetProperty(index: Cardinal; propID: propID;var value: OleVariant): HRESULT;
varitem: T7zBatchItem;
beginitem := T7zBatchItem(FBatchList[index]);case propID ofkpidAttributes:beginTPropVariant(value).vt := VT_UI4;TPropVariant(value).ulVal := item.Attributes;end;kpidLastWriteTime:beginTPropVariant(value).vt := VT_FILETIME;TPropVariant(value).filetime := item.LastWriteTime;end;kpidPath:beginif item.path <> '' thenvalue := item.path;end;kpidIsFolder:value := item.IsFolder;kpidSize:beginTPropVariant(value).vt := VT_UI8;TPropVariant(value).uhVal.QuadPart := item.size;end;kpidCreationTime:beginTPropVariant(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;
varitem: T7zBatchItem;
beginitem := T7zBatchItem(FBatchList[index]);case item.SourceMode ofsmFile:inStream := T7zStream.Create(TFileStream.Create(item.filename,fmOpenRead or fmShareDenyNone), soOwned);smStream:beginitem.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;
beginnewData^ := 1;newProperties^ := 1;indexInArchive^ := Cardinal(-1);Result := S_OK;
end;procedure T7zOutArchive.SaveToFile(const filename: TFileName);
varf: TFileStream;
beginf := TFileStream.Create(filename, fmCreate);trySaveToStream(f);finallyf.Free;end;
end;procedure T7zOutArchive.SaveToStream(stream: TStream);
varstrm: ISequentialOutStream;
beginstrm := T7zStream.Create(stream);tryRINOK(OutArchive.UpdateItems(strm, FBatchList.count,self as IArchiveUpdateCallback));finallystrm := nil;end;
end;function T7zOutArchive.SetCompleted(completeValue: PInt64): HRESULT;
beginif Assigned(FProgressCallback) and (completeValue <> nil) thenResult := FProgressCallback(FProgressSender, false, completeValue^)elseResult := S_OK;
end;function T7zOutArchive.SetOperationResult(operationResult: Integer): HRESULT;
beginResult := S_OK;
end;procedure T7zOutArchive.SetPassword(const password: UnicodeString);
beginFPassword := password;
end;procedure T7zOutArchive.SetProgressCallback(sender: Pointer;callback: T7zProgressCallback);
beginFProgressCallback := callback;FProgressSender := sender;
end;procedure T7zOutArchive.SetPropertie(name: UnicodeString; value: OleVariant);
varintf: ISetProperties;p: PWideChar;
beginintf := OutArchive as ISetProperties;p := PWideChar(name);RINOK(intf.SetProperties(@p, @TPropVariant(value), 1));
end;function T7zOutArchive.SetTotal(total: Int64): HRESULT;
beginif Assigned(FProgressCallback) thenResult := FProgressCallback(FProgressSender, true, total)elseResult := S_OK;
end;end.二、将 7z.dll 放到程序运行目录
https://download.csdn.net/download/qq_33397419/86401066
三、使用方法
usesD7zUtils, SevenZip;//-------------------------------------------------------------//【解压文件】
procedure TForm1.btn1Click(Sender: TObject);
beginwith CreateInArchive(CLSID_CFormatZip) dobegin//将1.zip中文件解压到C盘根目录OpenFile('c:\1.zip');ExtractTo('c:\');end;
end;//-------------------------------------------------------------//【压缩文件】
procedure TForm1.btn2Click(Sender: TObject);
beginwith CreateOutArchive(CLSID_CFormatZip) dobegin//将1.txt中文件压缩到1.zipAddFile('c:\1.txt','1.txt');SaveToFile('c:\1.zip')end;
end;路过的点个赞再走，谢谢~
为了节省磁盘空间,随时将文件压压缩保存是很好的习惯.可恰恰是这个好习惯却让笔者的朋友犯了难,因为他需要从多个压缩包中提取文件,但是由于压缩文件数量众多,而且提取出来的文件都保存到同一个目录内,如果用鼠 ... 对于在Linux下解压大型的*.zip文件,相信大家一般都会通过使用winrar直接在smb中来进行解压的操作,虽然说最终可能能够解压但有时候会存在解压时间长或者网络原因出错等故障的情况出现.那么有没 ... 用java压缩/解压文件: import java.io.*; import java.awt.*; import java.awt.event.*; import java.util.*; impo ... 命令行下(bat)使用 Lhaplus 自动 压缩 解压文件,参数设定 https://mp.csdn.net/console/editor/html/104400832 ■前言 准备测试数据,要压缩 ... 使用WinRAR压缩管理器压缩解压文件详细步骤如下: ■ 压缩文件 ① 鼠标右键需要压缩的文件,点击"添加到压缩文件",具体操作步骤如图所示: ② 压缩后的对应文件压缩包会显示在桌 ... 使用jar命令压缩和解压文件不会继承原来的权限,切记! 而使用zip/unzip压缩解压文件则会保留文件原来的权限等信息,因此使用压缩解压的时候尽量使用专业的工具 下面是测试内容和结果: 1.首先确认 ... 您是否遇到过精力了好久下回来的压缩吧,结果在解压过程中出现错误的情况呢?比如说此解压失败或压缩文件文件已经损坏?导致解压文件失败.如果遇到这种问题,那就试试常见的压缩解压文件出错解决办法吧.凡事求人不 ... tar多线程压缩解压文件 tar -czvf a.tar.gz ./* 测试每分钟压缩包a.tar.gz增长大约300M 安装多线程程序 yum -y install pigz 实测,4核的机器,2G ... 为了便于文件在网络中的传输和保存,通常将文件进行压缩操作,常用的压缩格式有rar.zip和7z,本文将介绍在C#中如何对这几种类型的文件进行压缩和解压,并提供一些在C#中解压缩文件的开源库. 在C#. ...Delphi压缩解压文件，无需第三方控件相关推荐
最新文章
热门文章