From 684f3f228a7d29591de2615661e9f55dc653768f Mon Sep 17 00:00:00 2001 From: wang80919 Date: Fri, 23 Mar 2018 11:52:13 +0800 Subject: [PATCH 01/10] Update and rename readme.htm to readme.txt MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 修改说明文档。 --- readme.htm | 44 -------------------------------------------- readme.txt | 13 +++++++++++++ 2 files changed, 13 insertions(+), 44 deletions(-) delete mode 100644 readme.htm create mode 100644 readme.txt diff --git a/readme.htm b/readme.htm deleted file mode 100644 index 772a4ee..0000000 --- a/readme.htm +++ /dev/null @@ -1,44 +0,0 @@ - -Fragment -of main.html - - - -

7-zip -Delphi API

-

This API use the 7-zip dll (7z.dll) to read and write all 7-zip -supported archive formats.

- Autor: Henri Gourvest <hgourvest@progdigy.com>
- Licence: MPL1.1
- Date: 15/04/2009
- Version: 1.1

-

Reading archive:

-

Extract to path:

-
 with CreateInArchive(CLSID_CFormatZip) do
 begin
   OpenFile('c:\test.zip');
   ExtractTo('c:\test');
 end;

Get -file list:

-
 with CreateInArchive(CLSID_CFormat7z) do
 begin
   OpenFile('c:\test.7z');
   for i := 0 to NumberOfItems - 1 do
    if not ItemIsFolder[i] then
      Writeln(ItemPath[i]);
 end;

Extract -to stream

-
 with CreateInArchive(CLSID_CFormat7z) do
 begin
   OpenFile('c:\test.7z');
   for i := 0 to NumberOfItems - 1 do
     if not ItemIsFolder[i] then
       ExtractItem(i, stream, false);
 end;

Extract -"n" Items

-
function GetStreamCallBack(sender: Pointer; index: Cardinal;
  var outStream: ISequentialOutStream): HRESULT; stdcall;
begin
  case index of ...
    outStream := T7zStream.Create(aStream, soReference);
  Result := S_OK;
end;

procedure TMainForm.ExtractClick(Sender: TObject);
var
  i: integer;
  items: array[0..2] of Cardinal;
begin
  with CreateInArchive(CLSID_CFormat7z) do
  begin
    OpenFile('c:\test.7z');
    // items must be sorted by index!
    items[0] := 0;
    items[1] := 1;
    items[2] := 2;
    ExtractItems(@items, Length(items), false, nil, GetStreamCallBack);
  end;
end;

Open -stream

-
 with CreateInArchive(CLSID_CFormatZip) do
 begin
   OpenStream(T7zStream.Create(TFileStream.Create('c:\test.zip', fmOpenRead), soOwned));
   OpenStream(aStream, soReference);
   ...
 end;

Progress -bar

-
 function ProgressCallback(sender: Pointer; total: boolean; value: int64): HRESULT; stdcall;
 begin
   if total then
     Mainform.ProgressBar.Max := value else
     Mainform.ProgressBar.Position := value;
   Result := S_OK;
 end;

 procedure TMainForm.ExtractClick(Sender: TObject);
 begin
   with CreateInArchive(CLSID_CFormatZip) do
   begin
     OpenFile('c:\test.zip');
     SetProgressCallback(nil, ProgressCallback);
     ...
   end;
 end;

Password

-
 function PasswordCallback(sender: Pointer; var password: WideString): HRESULT; stdcall;
 begin
   // call a dialog box ...
   password := 'password';
   Result := S_OK;
 end;

 procedure TMainForm.ExtractClick(Sender: TObject);
 begin
   with CreateInArchive(CLSID_CFormatZip) do
   begin
     // using callback
     SetPasswordCallback(nil, PasswordCallback);
     // or setting password directly
     SetPassword('password');
     OpenFile('c:\test.zip');
     ...
   end;
 end;

Writing -archive

-
 procedure TMainForm.ExtractAllClick(Sender: TObject);
 var
   Arch: I7zOutArchive;
 begin
   Arch := CreateOutArchive(CLSID_CFormat7z);
   // add a file
   Arch.AddFile('c:\test.bin', 'folder\test.bin');
   // add files using willcards and recursive search
   Arch.AddFiles('c:\test', 'folder', '*.pas;*.dfm', true);
   // add a stream
   Arch.AddStream(aStream, soReference, faArchive, CurrentFileTime, CurrentFileTime, 'folder\test.bin', false, false);
   // compression level
   SetCompressionLevel(Arch, 5);
   // compression method if <> LZMA
   SevenZipSetCompressionMethod(Arch, m7BZip2);
   // add a progress bar ...
   Arch.SetProgressCallback(...);
   // set a password if necessary
   Arch.SetPassword('password');
   // Save to file
   Arch.SaveToFile('c:\test.zip');
   // or a stream
   Arch.SaveToStream(aStream);
 end;

-
- \ No newline at end of file diff --git a/readme.txt b/readme.txt new file mode 100644 index 0000000..80ae433 --- /dev/null +++ b/readme.txt @@ -0,0 +1,13 @@ +官网已经找不到了。 +这个地址比较新 +https://github.com/zedalaye/d7zip +在这个基础上 融合了 +SevenZip.pas BUG修改版 - 20160613 - 堕落恶魔 - 博客园 +https://www.cnblogs.com/hs-kill/p/3876160.html +然后再加了一些小的修改。 + +最后，提供一个比较全面的 例子。 +【Delphi】从内存读取或解压压缩文件（RAR、ZIP、TAR、GZIP等）（一） - 峋山隐修会 - 博客园 +http://www.cnblogs.com/caibirdy1985/archive/2013/05/13/4232949.html +【Delphi】从内存读取或解压压缩文件（RAR、ZIP、TAR、GZIP等）（二） - 峋山隐修会 - 博客园 +http://www.cnblogs.com/caibirdy1985/archive/2013/05/14/4232948.html From 626ad160001bb62671c959e43d052bea5047e950 Mon Sep 17 00:00:00 2001 From: wang80919 Date: Fri, 23 Mar 2018 11:55:01 +0800 Subject: [PATCH 02/10] Update sevenzip.pas update to 1.2.1 and fix to 1.2.3 --- sevenzip.pas | 272 +++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 263 insertions(+), 9 deletions(-) diff --git a/sevenzip.pas b/sevenzip.pas index 1d7eea9..e1a194b 100644 --- a/sevenzip.pas +++ b/sevenzip.pas @@ -13,14 +13,52 @@ (* V1.2 *) (********************************************************************************) +//V1.1.1(aka 1.2.1) + +(* +2017-06-08 刘志林 修改 + +BUG修改: +1.对于文件名中带有空格的文件, 无法压缩, 原因是1743行, 压缩调用的是TStringList.Delimiter 来拆分文件字符串, 而空格是默认分行符, 导致文件名错误 +2.解压缩函数, 如果目标文件已存在并且为只读属性时, 报错, 原因是1383行 创建文件流的时候直接使用了TFileStream.Create(path, fmCreate)导致 +3.解压缩函数, 解决如果是空文件夹不会被创建的问题 + +功能增加: +1.增加了一个WorkPath变量, 用于指定7z.dll文件的绝对路径 +2.增加了一个解压缩过程中文件释放失败时的回调T7zProgressExceptCallback, 支持忽略/重试/取消 + +*) + + +//V1.2.2 +//新增对 callback 处理错误。 +//fix by flying wang. + +//V1.2.3 +//新增解压文件的属性设置。 +//add IncludeEmptyDir +//fix by flying wang. + unit sevenzip; {$ALIGN ON} {$MINENUMSIZE 4} -{$WARN SYMBOL_PLATFORM OFF} +{$WARN SYMBOL_PLATFORM OFF} interface uses SysUtils, Windows, ActiveX, Classes, Contnrs; +var + //fix by 刘志林 + G_7zWorkPath: string; {工作路径，查找dll用} + +const + //fix by flying wang. + kCallBackError = $0FFFFFFF; + kCallbackCANCEL = $0FFFFFFE; + kCallbackIGNORE = $0FFFFFFD; + + + type PVarType = ^TVarType; PCardArray = ^TCardArray; @@ -710,6 +748,13 @@ interface T7zGetStreamCallBack = function(sender: Pointer; index: Cardinal; var outStream: ISequentialOutStream): HRESULT; stdcall; T7zProgressCallback = function(sender: Pointer; total: boolean; value: int64): HRESULT; stdcall; + //fix by 刘志林 + NECallBack = ( + EC_RETRY = 0, + EC_IGNORE, + EC_CANCEL + ); + T7zProgressExceptCallback = function(sender: Pointer; AFile: string): NECallBack; stdcall; I7zInArchive = interface ['{022CF785-3ECE-46EF-9755-291FA84CC6C9}'] @@ -720,6 +765,10 @@ interface function GetItemPath(const index: integer): UnicodeString; stdcall; function GetItemName(const index: integer): UnicodeString; stdcall; function GetItemSize(const index: integer): Cardinal; stdcall; + //fix by flying wang. + function GetItemCompressedSize(const index: integer): Cardinal; stdcall; + function GetItemFileTime(const index: integer): TFileTime; stdcall; + function GetItemDataTime(const index: integer): TDateTime; stdcall; function GetItemIsFolder(const index: integer): boolean; stdcall; function GetInArchive: IInArchive; procedure ExtractItem(const item: Cardinal; Stream: TStream; test: longbool); stdcall; @@ -730,6 +779,8 @@ interface procedure SetPasswordCallback(sender: Pointer; callback: T7zPasswordCallback); stdcall; procedure SetPassword(const password: UnicodeString); stdcall; procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall; + //fix by 刘志林 + procedure SetProgressExceptCallback(sender: Pointer; callback: T7zProgressExceptCallback); stdcall; procedure SetClassId(const classid: TGUID); function GetClassId: TGUID; property ClassId: TGUID read GetClassId write SetClassId; @@ -737,6 +788,10 @@ interface property ItemPath[const index: integer]: UnicodeString read GetItemPath; property ItemName[const index: integer]: UnicodeString read GetItemName; property ItemSize[const index: integer]: Cardinal read GetItemSize; + //fix by flying wang. + property ItemCompressedSize[const index: integer]: Cardinal read GetItemCompressedSize; + property ItemFileTime[const index: integer]: TFileTime read GetItemFileTime; + property ItemDataTime[const index: integer]: TDateTime read GetItemDataTime; property ItemIsFolder[const index: integer]: boolean read GetItemIsFolder; property InArchive: IInArchive read GetInArchive; end; @@ -747,7 +802,7 @@ interface CreationTime, LastWriteTime: TFileTime; const Path: UnicodeString; IsFolder, IsAnti: boolean); stdcall; procedure AddFile(const Filename: TFileName; const Path: UnicodeString); stdcall; - procedure AddFiles(const Dir, Path, Wildcard: string; recurse: boolean); stdcall; + procedure AddFiles(const Dir, Path, Wildcard: string; recurse, IncludeEmptyDir: boolean); stdcall; procedure SaveToFile(const FileName: TFileName); stdcall; procedure SaveToStream(stream: TStream); stdcall; procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall; @@ -910,6 +965,16 @@ function CurrentFileTime: TFileTime; procedure RINOK(const hr: HRESULT); begin + //fix by flying wang. + if hr = kCallBackError then + begin + raise Exception.Create('Callback error.'); + exit; + end; + if (hr = kCallbackCANCEL) or (hr = kCallbackIGNORE) then + begin + exit; + end; if hr <> S_OK then raise Exception.Create(SysErrorMessage(hr)); end; @@ -1071,11 +1136,18 @@ T7zInArchive = class(T7zArchive, I7zInArchive, IProgress, IArchiveOpenCallback IArchiveExtractCallback, ICryptoGetTextPassword, IArchiveOpenVolumeCallback, IArchiveOpenSetSubArchiveName) private + //fix by flying wang. + FLasstFileAttr: Cardinal; + FLastWriteFileDataTime: TDateTime; + FLastWriteFile: string; FInArchive: IInArchive; FPasswordCallback: T7zPasswordCallback; FPasswordSender: Pointer; FProgressCallback: T7zProgressCallback; FProgressSender: Pointer; + //fix by 刘志林 + FProgressExceptCallback: T7zProgressExceptCallback; + FProgressExceptSender: Pointer; FStream: TStream; FPasswordIsDefined: Boolean; FPassword: UnicodeString; @@ -1086,6 +1158,8 @@ T7zInArchive = class(T7zArchive, I7zInArchive, IProgress, IArchiveOpenCallback FExtractPath: string; function GetInArchive: IInArchive; function GetItemProp(const Item: Cardinal; prop: PROPID): OleVariant; + //fix by flying wang. + procedure ResetLastFileInfo; protected // I7zInArchive procedure OpenFile(const filename: string); stdcall; @@ -1095,11 +1169,17 @@ T7zInArchive = class(T7zArchive, I7zInArchive, IProgress, IArchiveOpenCallback function GetItemPath(const index: integer): UnicodeString; stdcall; function GetItemName(const index: integer): UnicodeString; stdcall; function GetItemSize(const index: integer): Cardinal; stdcall; stdcall; + //fix by flying wang. + function GetItemCompressedSize(const index: integer): Cardinal; stdcall; + function GetItemFileTime(const index: integer): TFileTime; stdcall; + function GetItemDataTime(const index: integer): TDateTime; 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; + //fix by 刘志林 + procedure SetProgressExceptCallback(sender: Pointer; callback: T7zProgressExceptCallback); stdcall; procedure ExtractAll(test: longbool; sender: pointer; callback: T7zGetStreamCallBack); stdcall; procedure ExtractTo(const path: string); stdcall; procedure SetPassword(const password: UnicodeString); stdcall; @@ -1142,7 +1222,7 @@ T7zOutArchive = class(T7zArchive, I7zOutArchive, IArchiveUpdateCallback, ICryp Attributes: Cardinal; CreationTime, LastWriteTime: TFileTime; const Path: UnicodeString; IsFolder, IsAnti: boolean); stdcall; procedure AddFile(const Filename: TFileName; const Path: UnicodeString); stdcall; - procedure AddFiles(const Dir, Path, Wildcard: string; recurse: boolean); stdcall; + procedure AddFiles(const Dir, Path, Wildcard: string; recurse, IncludeEmptyDir: boolean); stdcall; procedure SaveToFile(const FileName: TFileName); stdcall; procedure SaveToStream(stream: TStream); stdcall; procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall; @@ -1171,13 +1251,13 @@ T7zOutArchive = class(T7zArchive, I7zOutArchive, IArchiveUpdateCallback, ICryp function CreateInArchive(const classid: TGUID; const lib: string): I7zInArchive; begin - Result := T7zInArchive.Create(lib); + Result := T7zInArchive.Create(G_7zWorkPath + lib); Result.ClassId := classid; end; function CreateOutArchive(const classid: TGUID; const lib: string): I7zOutArchive; begin - Result := T7zOutArchive.Create(lib); + Result := T7zOutArchive.Create(G_7zWorkPath + lib); Result.ClassId := classid; end; @@ -1276,6 +1356,8 @@ function T7zCodec.SetRatioInfo(inSize, outSize: PInt64): HRESULT; procedure T7zInArchive.Close; stdcall; begin + //fix by flying wang. + ResetLastFileInfo; FPasswordIsDefined := false; FSubArchiveMode := false; FInArchive.Close; @@ -1285,6 +1367,8 @@ procedure T7zInArchive.Close; stdcall; constructor T7zInArchive.Create(const lib: string); begin inherited; + //fix by flying wang. + ResetLastFileInfo; FPasswordCallback := nil; FPasswordSender := nil; FPasswordIsDefined := false; @@ -1299,6 +1383,14 @@ destructor T7zInArchive.Destroy; inherited; end; +procedure T7zInArchive.ResetLastFileInfo; +begin + //fix by flying wang. + FLasstFileAttr := faNormal; + FLastWriteFileDataTime := MinDateTime; + FLastWriteFile := ''; +end; + function T7zInArchive.GetInArchive: IInArchive; begin if FInArchive = nil then @@ -1320,6 +1412,8 @@ procedure T7zInArchive.OpenFile(const filename: string); stdcall; var strm: IInStream; begin + //fix by flying wang. + ResetLastFileInfo; strm := T7zStream.Create(TFileStream.Create(filename, fmOpenRead or fmShareDenyNone), soOwned); try RINOK( @@ -1335,6 +1429,8 @@ procedure T7zInArchive.OpenFile(const filename: string); stdcall; procedure T7zInArchive.OpenStream(stream: IInStream); stdcall; begin + //fix by flying wang. + ResetLastFileInfo; RINOK(InArchive.Open(stream, @MAXCHECK, self as IArchiveOpenCallBack)); end; @@ -1365,6 +1461,9 @@ function T7zInArchive.GetStream(index: Cardinal; var outStream: ISequentialOutStream; askExtractMode: NAskMode): HRESULT; var path: string; + //fix by 刘志林 + nFileStream: TFileStream; + nECR: NECallBack; begin if askExtractMode = kExtract then if FStream <> nil then @@ -1376,11 +1475,66 @@ function T7zInArchive.GetStream(index: Cardinal; end else if FExtractPath <> '' then begin - if not GetItemIsFolder(index) then +// //fix or remove by flying wang. +// if not GetItemIsFolder(index) then +// begin +// path := FExtractPath + GetItemPath(index); +// ForceDirectories(ExtractFilePath(path)); +// outStream := T7zStream.Create(TFileStream.Create(path, fmCreate), soOwned); +// end; + //fix by 刘志林 and flying wang. + if GetItemIsFolder(index) then + begin + path := FExtractPath + GetItemPath(index); + ForceDirectories(path); + end + else begin path := FExtractPath + GetItemPath(index); ForceDirectories(ExtractFilePath(path)); - outStream := T7zStream.Create(TFileStream.Create(path, fmCreate), soOwned); + FLasstFileAttr := 0; + if FileExists(path) then + begin + FLasstFileAttr := FileGetAttr(path); + if FLasstFileAttr <> faNormal then + FileSetAttr(path, faNormal); + end; + + nFileStream := nil; + repeat + try + //能写入即可。 + nFileStream := TFileStream.Create(Path, fmCreate or fmOpenReadWrite or fmShareDenyWrite); + //建立文件大小。 + nFileStream.Size := GetItemSize(index); + nFileStream.Position := 0; + except + FreeAndNil(nFileStream); + if not Assigned(FProgressExceptCallback) then + nECR := EC_CANCEL + else + nECR := FProgressExceptCallback(FProgressExceptSender, Path); + end; + until (nFileStream <> nil) or (nECR <> EC_RETRY); + if nFileStream = nil then + begin +// Result := kCallbackIGNORE; + if nECR = EC_CANCEL then + begin + Result := kCallbackCANCEL; + Exit; + end; + end + else + begin + FreeAndNil(nFileStream); + FLastWriteFileDataTime := GetItemDataTime(index); + FLastWriteFile := path; + if (FLasstFileAttr <> 0) and (FLasstFileAttr <> faNormal) then + FileSetAttr(FLastWriteFile, FLasstFileAttr); + FileSetDate(FLastWriteFile, DateTimeToFileDate(FLastWriteFileDataTime)); + outStream := T7zStream.Create(TFileStream.Create(path, fmCreate), soOwned); + end; end; end; Result := S_OK; @@ -1393,6 +1547,8 @@ function T7zInArchive.PrepareOperation(askExtractMode: NAskMode): HRESULT; function T7zInArchive.SetCompleted(completeValue: PInt64): HRESULT; begin + //fix by flying wang. + Result := kCallBackError; if Assigned(FProgressCallback) and (completeValue <> nil) then Result := FProgressCallback(FProgressSender, false, completeValue^) else Result := S_OK; @@ -1406,11 +1562,21 @@ function T7zInArchive.SetCompleted(files, bytes: PInt64): HRESULT; function T7zInArchive.SetOperationResult( resultEOperationResult: NExtOperationResult): HRESULT; begin + //fix by flying wang. + if FileExists(FLastWriteFile) then + begin + if (FLasstFileAttr <> 0) and (FLasstFileAttr <> faNormal) then + FileSetAttr(FLastWriteFile, FLasstFileAttr); + FileSetDate(FLastWriteFile, DateTimeToFileDate(FLastWriteFileDataTime)); + end; + ResetLastFileInfo; Result := S_OK; end; function T7zInArchive.SetTotal(total: Int64): HRESULT; begin + //fix by flying wang. + Result := kCallBackError; if Assigned(FProgressCallback) then Result := FProgressCallback(FProgressSender, true, total) else Result := S_OK; @@ -1432,6 +1598,8 @@ function T7zInArchive.CryptoGetTextPassword(var password: TBStr): HRESULT; end else if Assigned(FPasswordCallback) then begin + //fix by flying wang. + Result := kCallBackError; Result := FPasswordCallBack(FPasswordSender, wpass); if Result = S_OK then begin @@ -1479,6 +1647,32 @@ function T7zInArchive.GetItemSize(const index: integer): Cardinal; stdcall; Result := Cardinal(GetItemProp(index, kpidSize)); end; +//fix by flying wang. +function T7zInArchive.GetItemCompressedSize(const index: integer): Cardinal; stdcall; +begin + Result := Cardinal(GetItemProp(index, kpidPackSize)); +end; + +function T7zInArchive.GetItemFileTime(const index: integer): TFileTime; stdcall; +var + value: OleVariant; +begin + value := GetItemProp(index, kpidMTime); + if TPropVariant(value).vt = VT_FILETIME then + begin + Result := TPropVariant(value).filetime; + end; +end; + +function T7zInArchive.GetItemDataTime(const index: integer): TDateTime; stdcall; +var + A: TFileTime; +begin + Result := MinDateTime; + A := GetItemFileTime(index); + Result := FileTimeToDateTime(A); +end; + procedure T7zInArchive.ExtractItems(items: PCardArray; count: cardinal; test: longbool; sender: pointer; callback: T7zGetStreamCallBack); stdcall; begin @@ -1501,6 +1695,14 @@ procedure T7zInArchive.SetProgressCallback(sender: Pointer; FProgressCallback := callback; end; +//fix by 刘志林 +procedure T7zInArchive.SetProgressExceptCallback(sender: Pointer; + callback: T7zProgressExceptCallback); +begin + FProgressExceptSender := sender; + FProgressExceptCallback := callback; +end; + procedure T7zInArchive.ExtractAll(test: longbool; sender: pointer; callback: T7zGetStreamCallBack); begin @@ -1686,14 +1888,16 @@ procedure T7zOutArchive.AddFile(const Filename: TFileName; const Path: UnicodeSt GetFileTime(Handle, @item.CreationTime, nil, @item.LastWriteTime); item.Size := GetFileSize(Handle, nil); CloseHandle(Handle); - item.Attributes := GetFileAttributes(PChar(Filename)); + //item.Attributes := GetFileAttributes(PChar(Filename)); + //fix By Flying Wang. + item.Attributes := FileGetAttr(Filename); item.IsFolder := false; item.IsAnti := False; item.Ownership := soOwned; FBatchList.Add(item); end; -procedure T7zOutArchive.AddFiles(const Dir, Path, Wildcard: string; recurse: boolean); +procedure T7zOutArchive.AddFiles(const Dir, Path, Wildcard: string; recurse, IncludeEmptyDir: boolean); var lencut: integer; willlist: TStringList; @@ -1703,6 +1907,7 @@ procedure T7zOutArchive.AddFiles(const Dir, Path, Wildcard: string; recurse: boo f: TSearchRec; i: integer; item: T7zBatchItem; + IsEmpty: Boolean; begin if recurse then begin @@ -1716,8 +1921,10 @@ procedure T7zOutArchive.AddFiles(const Dir, Path, Wildcard: string; recurse: boo for i := 0 to willlist.Count - 1 do begin + IsEmpty := True; if FindFirst(p + willlist[i], faReadOnly or faHidden or faSysFile or faArchive, f) = 0 then repeat + IsEmpty := False; item := T7zBatchItem.Create; Item.SourceMode := smFile; item.Stream := nil; @@ -1735,6 +1942,24 @@ procedure T7zOutArchive.AddFiles(const Dir, Path, Wildcard: string; recurse: boo FBatchList.Add(item); until FindNext(f) <> 0; SysUtils.FindClose(f); + if IncludeEmptyDir and IsEmpty and (not FileExists(p)) and DirectoryExists(p) then + begin + item := T7zBatchItem.Create; + Item.SourceMode := smFile; + item.Stream := nil; + item.FileName := p; + 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 := True; + item.IsAnti := False; + item.Ownership := soOwned; + FBatchList.Add(item); + end; end; end; begin @@ -1842,6 +2067,27 @@ function T7zOutArchive.GetProperty(index: Cardinal; propID: PROPID; TPropVariant(value).vt := VT_FILETIME; TPropVariant(value).filetime := item.CreationTime; end; + //add by flying wang. + kpidATime: + begin + TPropVariant(value).vt := VT_FILETIME; + TPropVariant(value).filetime := item.LastWriteTime; + end; + kpidTimeType: + begin + TPropVariant(value).vt := VT_UI4; +{$IFDEF MSWINDOWS} + TPropVariant(value).ulVal := Integer(kWindows); +{$ELSE MSWINDOWS} + TPropVariant(value).ulVal := Integer(kUnix); +{$ENDIF MSWINDOWS} + end; +////fix by flying wang. +// kpidPackSize: +// begin +// TPropVariant(Value).vt := VT_UI8; +// TPropVariant(Value).uhVal.QuadPart := item.PackSize; +// end; kpidIsAnti: value := item.IsAnti; else // beep(0,0); @@ -1901,6 +2147,8 @@ procedure T7zOutArchive.SaveToStream(stream: TStream); function T7zOutArchive.SetCompleted(completeValue: PInt64): HRESULT; begin + //fix by flying wang. + Result := kCallBackError; if Assigned(FProgressCallback) and (completeValue <> nil) then Result := FProgressCallback(FProgressSender, false, completeValue^) else Result := S_OK; @@ -1937,9 +2185,15 @@ procedure T7zOutArchive.SetPropertie(name: UnicodeString; function T7zOutArchive.SetTotal(total: Int64): HRESULT; begin + //fix by flying wang. + Result := kCallBackError; if Assigned(FProgressCallback) then Result := FProgressCallback(FProgressSender, true, total) else Result := S_OK; end; +initialization + G_7zWorkPath := ''; + end. + From a27a324e35f17e83964db18a9db65bc90707b6da Mon Sep 17 00:00:00 2001 From: wang80919 Date: Fri, 23 Mar 2018 12:13:37 +0800 Subject: [PATCH 03/10] =?UTF-8?q?=E4=BF=AE=E6=94=B9=E9=94=99=E5=88=AB?= =?UTF-8?q?=E5=AD=97?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- sevenzip.pas | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/sevenzip.pas b/sevenzip.pas index e1a194b..73f49f5 100644 --- a/sevenzip.pas +++ b/sevenzip.pas @@ -1137,7 +1137,7 @@ T7zInArchive = class(T7zArchive, I7zInArchive, IProgress, IArchiveOpenCallback IArchiveOpenSetSubArchiveName) private //fix by flying wang. - FLasstFileAttr: Cardinal; + FLastWriteFileAttr: Cardinal; FLastWriteFileDataTime: TDateTime; FLastWriteFile: string; FInArchive: IInArchive; @@ -1386,7 +1386,7 @@ destructor T7zInArchive.Destroy; procedure T7zInArchive.ResetLastFileInfo; begin //fix by flying wang. - FLasstFileAttr := faNormal; + FLastWriteFileAttr := faNormal; FLastWriteFileDataTime := MinDateTime; FLastWriteFile := ''; end; @@ -1492,11 +1492,11 @@ function T7zInArchive.GetStream(index: Cardinal; begin path := FExtractPath + GetItemPath(index); ForceDirectories(ExtractFilePath(path)); - FLasstFileAttr := 0; + FLastWriteFileAttr := 0; if FileExists(path) then begin - FLasstFileAttr := FileGetAttr(path); - if FLasstFileAttr <> faNormal then + FLastWriteFileAttr := FileGetAttr(path); + if FLastWriteFileAttr <> faNormal then FileSetAttr(path, faNormal); end; @@ -1530,8 +1530,8 @@ function T7zInArchive.GetStream(index: Cardinal; FreeAndNil(nFileStream); FLastWriteFileDataTime := GetItemDataTime(index); FLastWriteFile := path; - if (FLasstFileAttr <> 0) and (FLasstFileAttr <> faNormal) then - FileSetAttr(FLastWriteFile, FLasstFileAttr); + if (FLastWriteFileAttr <> 0) and (FLastWriteFileAttr <> faNormal) then + FileSetAttr(FLastWriteFile, FLastWriteFileAttr); FileSetDate(FLastWriteFile, DateTimeToFileDate(FLastWriteFileDataTime)); outStream := T7zStream.Create(TFileStream.Create(path, fmCreate), soOwned); end; @@ -1565,8 +1565,8 @@ function T7zInArchive.SetOperationResult( //fix by flying wang. if FileExists(FLastWriteFile) then begin - if (FLasstFileAttr <> 0) and (FLasstFileAttr <> faNormal) then - FileSetAttr(FLastWriteFile, FLasstFileAttr); + if (FLastWriteFileAttr <> 0) and (FLastWriteFileAttr <> faNormal) then + FileSetAttr(FLastWriteFile, FLastWriteFileAttr); FileSetDate(FLastWriteFile, DateTimeToFileDate(FLastWriteFileDataTime)); end; ResetLastFileInfo; From fc3d1d4d9c11caba24a9b0a2f9061812e321f79a Mon Sep 17 00:00:00 2001 From: wang80919 Date: Fri, 23 Mar 2018 12:45:49 +0800 Subject: [PATCH 04/10] =?UTF-8?q?=E6=9B=B4=E6=96=B0=E5=8E=9F=E7=89=88?= =?UTF-8?q?=E7=9A=84=E4=BB=A3=E7=A0=81=E8=AF=B4=E6=98=8E?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- readme.txt | 143 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 143 insertions(+) diff --git a/readme.txt b/readme.txt index 80ae433..64662f3 100644 --- a/readme.txt +++ b/readme.txt @@ -11,3 +11,146 @@ https://www.cnblogs.com/hs-kill/p/3876160.html http://www.cnblogs.com/caibirdy1985/archive/2013/05/13/4232949.html 【Delphi】从内存读取或解压压缩文件（RAR、ZIP、TAR、GZIP等）（二） - 峋山隐修会 - 博客园 http://www.cnblogs.com/caibirdy1985/archive/2013/05/14/4232948.html + + + +7-zip Delphi API +This API use the 7-zip dll (7z.dll) to read and write all 7-zip supported archive formats. + +- Autor: Henri Gourvest +- Licence: MPL1.1 +- Date: 15/04/2009 +- Version: 1.1 + +Reading archive: + +Extract to path: +解压到目录： +with CreateInArchive('Formats\zip.dll') do +begin + OpenFile('c:\test.zip'); + ExtractTo('c:\test'); +end; + +Get file list: +获取文件列表: +with CreateInArchive('Formats\7z.dll') do +begin + OpenFile('c:\test.7z'); + for i := 0 to NumberOfItems - 1 do + if not ItemIsFolder[i] then + Writeln(ItemPath[i]); +end; + +Extract to stream +解压到流: +with CreateInArchive('Formats\7z.dll') do +begin + OpenFile('c:\test.7z'); + for i := 0 to NumberOfItems - 1 do + if not ItemIsFolder[i] then + ExtractItem(i, stream, false); +end; + +Extract "n" Items +解压多项目: +function GetStreamCallBack(sender: Pointer; index: Cardinal; +var outStream: ISequentialOutStream): HRESULT; stdcall; +begin +case index of ... + outStream := T7zStream.Create(aStream, soReference); + Result := S_OK; +end; + +procedure TMainForm.ExtractClick(Sender: TObject); +var +i: integer; +items: array[0..2] of Cardinal; +begin + with CreateInArchive('Formats\7z.dll') do + begin + OpenFile('c:\test.7z'); + // items must be sorted by index! + items[0] := 0; + items[1] := 1; + items[2] := 2; + ExtractItems(@items, Length(items), false, nil, GetStreamCallBack); + end; +end; + +Open stream +打开流: +with CreateInArchive('Formats\zip.dll') do +begin + OpenStream(T7zStream.Create(TFileStream.Create('c:\test.zip', fmOpenRead), soOwned)); + OpenStream(aStream, soReference); + ... +end; + +Progress bar +进度条回调: +function ProgressCallback(sender: Pointer; total: boolean; value: int64): HRESULT; stdcall; +begin + if total then + Mainform.ProgressBar.Max := value else + Mainform.ProgressBar.Position := value; + Result := S_OK; +end; + +procedure TMainForm.ExtractClick(Sender: TObject); +begin + with CreateInArchive('Formats\zip.dll') do +begin + OpenFile('c:\test.zip'); + SetProgressCallback(nil, ProgressCallback); + ... + end; +end; + +Password +打开含有密码的文件: +function PasswordCallback(sender: Pointer; var password: WideString): HRESULT; stdcall; +begin + // call a dialog box ... + password := 'password'; + Result := S_OK; +end; +procedure TMainForm.ExtractClick(Sender: TObject); +begin + with CreateInArchive('Formats\zip.dll') do + begin + // using callback + SetPasswordCallback(nil, PasswordCallback); + // or setting password directly + SetPassword('password'); + OpenFile('c:\test.zip'); + ... + end; +end; + +Writing archive +压缩存档: +procedure TMainForm.ExtractAllClick(Sender: TObject); +var + Arch: I7zOutArchive; +begin + Arch := CreateOutArchive('Formats\7z.dll'); + // add a file + Arch.AddFile('c:\test.bin', 'folder\test.bin'); + // add files using willcards and recursive search + Arch.AddFiles('c:\test', 'folder', '*.pas;*.dfm', true, true); + // add a stream + Arch.AddStream(aStream, soReference, faArchive, CurrentFileTime, CurrentFileTime, 'folder\test.bin', false, false); + // compression level + SetCompressionLevel(Arch, 5); + // compression method if <> LZMA + SevenZipSetCompressionMethod(Arch, m7BZip2); + // add a progress bar ... + Arch.SetProgressCallback(...); + // set a password if necessary + Arch.SetPassword('password'); + // Save to file + Arch.SaveToFile('c:\test.zip'); + // or a stream + Arch.SaveToStream(aStream); +end; From 1d2bdfa82bcd95c4613f775af93f23608f944cb9 Mon Sep 17 00:00:00 2001 From: wang80919 Date: Fri, 23 Mar 2018 12:50:40 +0800 Subject: [PATCH 05/10] =?UTF-8?q?=E5=88=A0=E9=99=A4=E5=A4=9A=E4=BD=99?= =?UTF-8?q?=E7=9A=84=E4=BB=A3=E7=A0=81=E3=80=82?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- sevenzip.pas | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/sevenzip.pas b/sevenzip.pas index 73f49f5..da9ed97 100644 --- a/sevenzip.pas +++ b/sevenzip.pas @@ -1475,13 +1475,6 @@ function T7zInArchive.GetStream(index: Cardinal; end else if FExtractPath <> '' then begin -// //fix or remove by flying wang. -// if not GetItemIsFolder(index) then -// begin -// path := FExtractPath + GetItemPath(index); -// ForceDirectories(ExtractFilePath(path)); -// outStream := T7zStream.Create(TFileStream.Create(path, fmCreate), soOwned); -// end; //fix by 刘志林 and flying wang. if GetItemIsFolder(index) then begin @@ -1518,7 +1511,6 @@ function T7zInArchive.GetStream(index: Cardinal; until (nFileStream <> nil) or (nECR <> EC_RETRY); if nFileStream = nil then begin -// Result := kCallbackIGNORE; if nECR = EC_CANCEL then begin Result := kCallbackCANCEL; @@ -2082,12 +2074,6 @@ function T7zOutArchive.GetProperty(index: Cardinal; propID: PROPID; TPropVariant(value).ulVal := Integer(kUnix); {$ENDIF MSWINDOWS} end; -////fix by flying wang. -// kpidPackSize: -// begin -// TPropVariant(Value).vt := VT_UI8; -// TPropVariant(Value).uhVal.QuadPart := item.PackSize; -// end; kpidIsAnti: value := item.IsAnti; else // beep(0,0); From 58e22718f8fadc4ff7f5d045f849f66466ef49b0 Mon Sep 17 00:00:00 2001 From: wang80919 Date: Fri, 23 Mar 2018 12:54:43 +0800 Subject: [PATCH 06/10] Update readme.txt --- readme.txt | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/readme.txt b/readme.txt index 64662f3..02a0ecf 100644 --- a/readme.txt +++ b/readme.txt @@ -20,13 +20,13 @@ This API use the 7-zip dll (7z.dll) to read and write all 7-zip supported archiv - Autor: Henri Gourvest - Licence: MPL1.1 - Date: 15/04/2009 -- Version: 1.1 +- Version: 1.2 Reading archive: Extract to path: 解压到目录： -with CreateInArchive('Formats\zip.dll') do +with CreateInArchive(CLSID_CFormatZip) do begin OpenFile('c:\test.zip'); ExtractTo('c:\test'); @@ -34,7 +34,7 @@ end; Get file list: 获取文件列表: -with CreateInArchive('Formats\7z.dll') do +with CreateInArchive(CLSID_CFormat7z, 'Formats\7z.dll') do begin OpenFile('c:\test.7z'); for i := 0 to NumberOfItems - 1 do @@ -44,7 +44,7 @@ end; Extract to stream 解压到流: -with CreateInArchive('Formats\7z.dll') do +with CreateInArchive(CLSID_CFormat7z) do begin OpenFile('c:\test.7z'); for i := 0 to NumberOfItems - 1 do @@ -67,7 +67,7 @@ var i: integer; items: array[0..2] of Cardinal; begin - with CreateInArchive('Formats\7z.dll') do + with CreateInArchive(CLSID_CFormat7z) do begin OpenFile('c:\test.7z'); // items must be sorted by index! @@ -80,7 +80,7 @@ end; Open stream 打开流: -with CreateInArchive('Formats\zip.dll') do +with CreateInArchive(CLSID_CFormatZip) do begin OpenStream(T7zStream.Create(TFileStream.Create('c:\test.zip', fmOpenRead), soOwned)); OpenStream(aStream, soReference); @@ -99,7 +99,7 @@ end; procedure TMainForm.ExtractClick(Sender: TObject); begin - with CreateInArchive('Formats\zip.dll') do + with CreateInArchive(CLSID_CFormatZip) do begin OpenFile('c:\test.zip'); SetProgressCallback(nil, ProgressCallback); @@ -117,7 +117,7 @@ begin end; procedure TMainForm.ExtractClick(Sender: TObject); begin - with CreateInArchive('Formats\zip.dll') do + with CreateInArchive(CLSID_CFormatZip) do begin // using callback SetPasswordCallback(nil, PasswordCallback); @@ -134,7 +134,7 @@ procedure TMainForm.ExtractAllClick(Sender: TObject); var Arch: I7zOutArchive; begin - Arch := CreateOutArchive('Formats\7z.dll'); + Arch := CreateOutArchive(CLSID_CFormat7z); // add a file Arch.AddFile('c:\test.bin', 'folder\test.bin'); // add files using willcards and recursive search From b89d4d7a2bc26928a3e8a1de896feac1a79706ce Mon Sep 17 00:00:00 2001 From: wang80919 Date: Fri, 23 Mar 2018 18:40:30 +0800 Subject: [PATCH 07/10] =?UTF-8?q?=E6=94=AF=E6=8C=81=2064bit=20=E7=9A=84=20?= =?UTF-8?q?=E6=96=87=E4=BB=B6=E5=A4=A7=E5=B0=8F?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- sevenzip.pas | 103 ++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 90 insertions(+), 13 deletions(-) diff --git a/sevenzip.pas b/sevenzip.pas index da9ed97..e4e5d27 100644 --- a/sevenzip.pas +++ b/sevenzip.pas @@ -37,8 +37,11 @@ //V1.2.3 //新增解压文件的属性设置。 //add IncludeEmptyDir +//add support Int64 for file size //fix by flying wang. +//also you can use JclCompression instead of this. + unit sevenzip; {$ALIGN ON} {$MINENUMSIZE 4} @@ -764,9 +767,9 @@ interface 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 GetItemSize(const index: integer): Int64; stdcall; //fix by flying wang. - function GetItemCompressedSize(const index: integer): Cardinal; stdcall; + function GetItemCompressedSize(const index: integer): Int64; stdcall; function GetItemFileTime(const index: integer): TFileTime; stdcall; function GetItemDataTime(const index: integer): TDateTime; stdcall; function GetItemIsFolder(const index: integer): boolean; stdcall; @@ -787,9 +790,9 @@ interface 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 ItemSize[const index: integer]: Int64 read GetItemSize; //fix by flying wang. - property ItemCompressedSize[const index: integer]: Cardinal read GetItemCompressedSize; + property ItemCompressedSize[const index: integer]: Int64 read GetItemCompressedSize; property ItemFileTime[const index: integer]: TFileTime read GetItemFileTime; property ItemDataTime[const index: integer]: TDateTime read GetItemDataTime; property ItemIsFolder[const index: integer]: boolean read GetItemIsFolder; @@ -932,6 +935,64 @@ T7zStream = class(TInterfacedObject, IInStream, IStreamGetSize, CLSID_CFormatTar : TGUID = '{23170F69-40C1-278A-1000-000110EE0000}'; // [OUT] tar CLSID_CFormatGZip : TGUID = '{23170F69-40C1-278A-1000-000110EF0000}'; // [OUT] gz gzip tgz tpz +//fix or copy from Jedi JCL +// ZipHandlerOut.cpp +const + kDeflateAlgoX1 = 0 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kLzAlgoX1' {$ENDIF} {$ENDIF}; + kLzAlgoX1 = 0; + kDeflateAlgoX5 = 1 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kLzAlgoX5' {$ENDIF} {$ENDIF}; + kLzAlgoX5 = 1; + + kDeflateNumPassesX1 = 1; + kDeflateNumPassesX7 = 3; + kDeflateNumPassesX9 = 10; + + kNumFastBytesX1 = 32 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kDeflateNumFastBytesX1' {$ENDIF} {$ENDIF}; + kDeflateNumFastBytesX1 = 32; + kNumFastBytesX7 = 64 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kDeflateNumFastBytesX7' {$ENDIF} {$ENDIF}; + kDeflateNumFastBytesX7 = 64; + kNumFastBytesX9 = 128 {$IFDEF SUPPORTS_DEPRECATED} deprecated {$IFDEF SUPPORTS_DEPRECATED_DETAILS} 'Use kDeflateNumFastBytesX9' {$ENDIF} {$ENDIF}; + kDeflateNumFastBytesX9 = 128; + + kLzmaNumFastBytesX1 = 32; + kLzmaNumFastBytesX7 = 64; + + kBZip2NumPassesX1 = 1; + kBZip2NumPassesX7 = 2; + kBZip2NumPassesX9 = 7; + + kBZip2DicSizeX1 = 100000; + kBZip2DicSizeX3 = 500000; + kBZip2DicSizeX5 = 900000; + +// HandlerOut.cpp +const + kLzmaAlgoX1 = 0; + kLzmaAlgoX5 = 1; + + kLzmaDicSizeX1 = 1 shl 16; + kLzmaDicSizeX3 = 1 shl 20; + kLzmaDicSizeX5 = 1 shl 24; + kLzmaDicSizeX7 = 1 shl 25; + kLzmaDicSizeX9 = 1 shl 26; + + kLzmaFastBytesX1 = 32; + kLzmaFastBytesX7 = 64; + + kPpmdMemSizeX1 = (1 shl 22); + kPpmdMemSizeX5 = (1 shl 24); + kPpmdMemSizeX7 = (1 shl 26); + kPpmdMemSizeX9 = (192 shl 20); + + kPpmdOrderX1 = 4; + kPpmdOrderX5 = 6; + kPpmdOrderX7 = 16; + kPpmdOrderX9 = 32; + + kDeflateFastBytesX1 = 32; + kDeflateFastBytesX7 = 64; + kDeflateFastBytesX9 = 128; + implementation const @@ -1089,6 +1150,7 @@ procedure SevenZipVolumeMode(Arch: I7zOutArchive; Mode: boolean); type T7zPlugin = class(TInterfacedObject) private + FAutoUnLoad7Zip: Boolean; FHandle: THandle; FCreateObject: function(const clsid, iid :TGUID; var outObject): HRESULT; stdcall; public @@ -1168,9 +1230,9 @@ T7zInArchive = class(T7zArchive, I7zInArchive, IProgress, IArchiveOpenCallback 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 GetItemSize(const index: integer): Int64; stdcall; stdcall; //fix by flying wang. - function GetItemCompressedSize(const index: integer): Cardinal; stdcall; + function GetItemCompressedSize(const index: integer): Int64; stdcall; function GetItemFileTime(const index: integer): TFileTime; stdcall; function GetItemDataTime(const index: integer): TDateTime; stdcall; function GetItemIsFolder(const index: integer): boolean; stdcall; @@ -1266,6 +1328,7 @@ Result.ClassId := classid; constructor T7zPlugin.Create(const lib: string); begin + inherited Create; FHandle := LoadLibrary(PChar(lib)); if FHandle = 0 then raise exception.CreateFmt('Error loading library %s', [lib]); @@ -1475,6 +1538,13 @@ function T7zInArchive.GetStream(index: Cardinal; end else if FExtractPath <> '' then begin +// //fix or remove by flying wang. +// if not GetItemIsFolder(index) then +// begin +// path := FExtractPath + GetItemPath(index); +// ForceDirectories(ExtractFilePath(path)); +// outStream := T7zStream.Create(TFileStream.Create(path, fmCreate), soOwned); +// end; //fix by 刘志林 and flying wang. if GetItemIsFolder(index) then begin @@ -1511,6 +1581,7 @@ function T7zInArchive.GetStream(index: Cardinal; until (nFileStream <> nil) or (nECR <> EC_RETRY); if nFileStream = nil then begin +// Result := kCallbackIGNORE; if nECR = EC_CANCEL then begin Result := kCallbackCANCEL; @@ -1634,15 +1705,15 @@ function T7zInArchive.GetItemName(const index: integer): UnicodeString; stdcall; Result := UnicodeString(GetItemProp(index, kpidName)); end; -function T7zInArchive.GetItemSize(const index: integer): Cardinal; stdcall; +function T7zInArchive.GetItemSize(const index: integer): Int64; stdcall; begin - Result := Cardinal(GetItemProp(index, kpidSize)); + Result := Int64(GetItemProp(index, kpidSize)); end; //fix by flying wang. -function T7zInArchive.GetItemCompressedSize(const index: integer): Cardinal; stdcall; +function T7zInArchive.GetItemCompressedSize(const index: integer): Int64; stdcall; begin - Result := Cardinal(GetItemProp(index, kpidPackSize)); + Result := Int64(GetItemProp(index, kpidPackSize)); end; function T7zInArchive.GetItemFileTime(const index: integer): TFileTime; stdcall; @@ -1852,7 +1923,7 @@ T7zBatchItem = class IsFolder, IsAnti: boolean; FileName: TFileName; Ownership: TStreamOwnership; - Size: Cardinal; + Size: Int64; destructor Destroy; override; end; @@ -1869,6 +1940,8 @@ procedure T7zOutArchive.AddFile(const Filename: TFileName; const Path: UnicodeSt var item: T7zBatchItem; Handle: THandle; + TempSize: Int64; + TempSizeHi: Cardinal; begin if not FileExists(Filename) then exit; item := T7zBatchItem.Create; @@ -1878,7 +1951,9 @@ procedure T7zOutArchive.AddFile(const Filename: TFileName; const Path: UnicodeSt item.Path := Path; Handle := FileOpen(Filename, fmOpenRead or fmShareDenyNone); GetFileTime(Handle, @item.CreationTime, nil, @item.LastWriteTime); - item.Size := GetFileSize(Handle, nil); + Int64Rec(TempSize).Lo := GetFileSize(Handle, @TempSizeHi); + Int64Rec(TempSize).Hi := TempSizeHi; + item.Size := TempSize; CloseHandle(Handle); //item.Attributes := GetFileAttributes(PChar(Filename)); //fix By Flying Wang. @@ -2181,5 +2256,7 @@ function T7zOutArchive.SetTotal(total: Int64): HRESULT; initialization G_7zWorkPath := ''; -end. +//finalization + +end. From 963f2a653b652d561558e022e52006ae599301a0 Mon Sep 17 00:00:00 2001 From: wang80919 Date: Fri, 23 Mar 2018 18:45:10 +0800 Subject: [PATCH 08/10] =?UTF-8?q?=E5=86=8D=E6=AC=A1=E5=88=A0=E9=99=A4?= =?UTF-8?q?=E5=A4=9A=E4=BD=99=E4=BB=A3=E7=A0=81?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- sevenzip.pas | 9 --------- 1 file changed, 9 deletions(-) diff --git a/sevenzip.pas b/sevenzip.pas index e4e5d27..004043b 100644 --- a/sevenzip.pas +++ b/sevenzip.pas @@ -1150,7 +1150,6 @@ procedure SevenZipVolumeMode(Arch: I7zOutArchive; Mode: boolean); type T7zPlugin = class(TInterfacedObject) private - FAutoUnLoad7Zip: Boolean; FHandle: THandle; FCreateObject: function(const clsid, iid :TGUID; var outObject): HRESULT; stdcall; public @@ -1538,13 +1537,6 @@ function T7zInArchive.GetStream(index: Cardinal; end else if FExtractPath <> '' then begin -// //fix or remove by flying wang. -// if not GetItemIsFolder(index) then -// begin -// path := FExtractPath + GetItemPath(index); -// ForceDirectories(ExtractFilePath(path)); -// outStream := T7zStream.Create(TFileStream.Create(path, fmCreate), soOwned); -// end; //fix by 刘志林 and flying wang. if GetItemIsFolder(index) then begin @@ -1581,7 +1573,6 @@ function T7zInArchive.GetStream(index: Cardinal; until (nFileStream <> nil) or (nECR <> EC_RETRY); if nFileStream = nil then begin -// Result := kCallbackIGNORE; if nECR = EC_CANCEL then begin Result := kCallbackCANCEL; From 7163f9f743c32c5b89e8f7f496ee960c46c4136d Mon Sep 17 00:00:00 2001 From: wang80919 Date: Mon, 26 Mar 2018 13:16:11 +0800 Subject: [PATCH 09/10] add ExtractItemToPath from ekot1 from https://github.com/ekot1/d7zip --- sevenzip.pas | 121 ++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 111 insertions(+), 10 deletions(-) diff --git a/sevenzip.pas b/sevenzip.pas index 004043b..b620968 100644 --- a/sevenzip.pas +++ b/sevenzip.pas @@ -40,6 +40,11 @@ //add support Int64 for file size //fix by flying wang. +//V1.2.5 +//add some IFDEF MSWINDOWS +//add ExtractItemToPath from ekot1 +//fix by flying wang. + //also you can use JclCompression instead of this. unit sevenzip; @@ -48,7 +53,14 @@ {$WARN SYMBOL_PLATFORM OFF} interface -uses SysUtils, Windows, ActiveX, Classes, Contnrs; +uses +{$IFDEF MSWINDOWS} + Windows, ActiveX, +{$ENDIF MSWINDOWS} +{$IFDEF POSIX} + Posix.Dlfcn, Posix.Fcntl, +{$ENDIF POSIX} + SysUtils, Classes, Contnrs; var //fix by 刘志林 @@ -770,11 +782,15 @@ interface function GetItemSize(const index: integer): Int64; stdcall; //fix by flying wang. function GetItemCompressedSize(const index: integer): Int64; stdcall; +{$IFDEF MSWINDOWS} function GetItemFileTime(const index: integer): TFileTime; stdcall; +{$ENDIF MSWINDOWS} function GetItemDataTime(const index: integer): TDateTime; stdcall; function GetItemIsFolder(const index: integer): boolean; stdcall; function GetInArchive: IInArchive; procedure ExtractItem(const item: Cardinal; Stream: TStream; test: longbool); stdcall; + //fix or add by ekot1 + procedure ExtractItemToPath(const item: Cardinal; const path: string; 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; @@ -793,7 +809,9 @@ interface property ItemSize[const index: integer]: Int64 read GetItemSize; //fix by flying wang. property ItemCompressedSize[const index: integer]: Int64 read GetItemCompressedSize; +{$IFDEF MSWINDOWS} property ItemFileTime[const index: integer]: TFileTime read GetItemFileTime; +{$ENDIF MSWINDOWS} property ItemDataTime[const index: integer]: TDateTime read GetItemDataTime; property ItemIsFolder[const index: integer]: boolean read GetItemIsFolder; property InArchive: IInArchive read GetInArchive; @@ -868,15 +886,24 @@ T7zStream = class(TInterfacedObject, IInStream, IStreamGetSize, procedure SevenZipEncryptHeaders(Arch: I7zOutArchive; Encrypt: boolean); // X procedure SevenZipVolumeMode(Arch: I7zOutArchive; Mode: boolean); // X +{$IFDEF MSWINDOWS} // filetime util functions function DateTimeToFileTime(dt: TDateTime): TFileTime; function FileTimeToDateTime(ft: TFileTime): TDateTime; function CurrentFileTime: TFileTime; +{$ENDIF MSWINDOWS} // constructors +const +{$IFDEF MSWINDOWS} + C_7zDllName = '7z.dll'; +{$ENDIF MSWINDOWS} +{$IFDEF POSIX} + C_7zDllName = 'lib7z.so'; +{$ENDIF POSIX} - function CreateInArchive(const classid: TGUID; const lib: string = '7z.dll'): I7zInArchive; - function CreateOutArchive(const classid: TGUID; const lib: string = '7z.dll'): I7zOutArchive; + function CreateInArchive(const classid: TGUID; const lib: string = C_7zDllName): I7zInArchive; + function CreateOutArchive(const classid: TGUID; const lib: string = C_7zDllName): I7zOutArchive; const CLSID_CFormatZip : TGUID = '{23170F69-40C1-278A-1000-000110010000}'; // [OUT] zip jar xpi @@ -1001,6 +1028,7 @@ implementation ZipEncryptionMethod: array[TZipEncryptionMethod] of UnicodeString = ('AES128', 'AES192', 'AES256', 'ZIPCRYPTO'); SevCompressionMethod: array[T7zCompressionMethod] of UnicodeString = ('COPY', 'LZMA', 'BZIP2', 'PPMD', 'DEFLATE', 'DEFLATE64'); +{$IFDEF MSWINDOWS} function DateTimeToFileTime(dt: TDateTime): TFileTime; var st: TSystemTime; @@ -1023,6 +1051,7 @@ function CurrentFileTime: TFileTime; begin GetSystemTimeAsFileTime(Result); end; +{$ENDIF MSWINDOWS} procedure RINOK(const hr: HRESULT); begin @@ -1147,6 +1176,50 @@ procedure SevenZipVolumeMode(Arch: I7zOutArchive; Mode: boolean); SetBooleanProperty(arch, 'V', Mode); end; +function LoadModule(FileName: string): THandle; +{$IFDEF MSWINDOWS} +begin + Result := SafeLoadLibrary(FileName); +end; +{$ENDIF MSWINDOWS} +{$IFDEF POSIX} +begin + Result := dlopen(PChar(FileName), RTLD_NOW); +end; +{$ENDIF POSIX} + +procedure UnloadModule(var Module: THandle); +{$IFDEF MSWINDOWS} +begin + if Module <> 0 then + FreeLibrary(Module); + Module := 0; +end; +{$ENDIF MSWINDOWS} +{$IFDEF POSIX} +begin + if Module <> 0 then + dlclose(Pointer(Module)); + Module := 0; +end; +{$ENDIF POSIX} + +function GetModuleSymbol(Module: THandle; SymbolName: string): Pointer; +{$IFDEF MSWINDOWS} +begin + Result := nil; + if Module <> 0 then + Result := GetProcAddress(Module, PChar(SymbolName)); +end; +{$ENDIF MSWINDOWS} +{$IFDEF POSIX} +begin + Result := nil; + if Module <> 0 then + Result := dlsym(Module, PChar(SymbolName)); +end; +{$ENDIF POSIX} + type T7zPlugin = class(TInterfacedObject) private @@ -1232,10 +1305,14 @@ T7zInArchive = class(T7zArchive, I7zInArchive, IProgress, IArchiveOpenCallback function GetItemSize(const index: integer): Int64; stdcall; stdcall; //fix by flying wang. function GetItemCompressedSize(const index: integer): Int64; stdcall; +{$IFDEF MSWINDOWS} function GetItemFileTime(const index: integer): TFileTime; stdcall; +{$ENDIF MSWINDOWS} function GetItemDataTime(const index: integer): TDateTime; stdcall; function GetItemIsFolder(const index: integer): boolean; stdcall; procedure ExtractItem(const item: Cardinal; Stream: TStream; test: longbool); stdcall; + //fix or add by ekot1 + procedure ExtractItemToPath(const item: Cardinal; const path: string; 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; @@ -1328,10 +1405,19 @@ Result.ClassId := classid; constructor T7zPlugin.Create(const lib: string); begin inherited Create; - FHandle := LoadLibrary(PChar(lib)); + FHandle := LoadModule(PChar(lib)); if FHandle = 0 then - raise exception.CreateFmt('Error loading library %s', [lib]); - FCreateObject := GetProcAddress(FHandle, 'CreateObject'); + begin + try + RaiseLastOSError; + except + on E: Exception do + begin + raise Exception.CreateFmt('Error loading library %s', [lib] + sLineBreak + 'Error Message: ' + E.Message); + end; + end; + end; + FCreateObject := GetModuleSymbol(FHandle, 'CreateObject'); if not (Assigned(FCreateObject)) then begin FreeLibrary(FHandle); @@ -1341,7 +1427,7 @@ constructor T7zPlugin.Create(const lib: string); destructor T7zPlugin.Destroy; begin - FreeLibrary(FHandle); + UnloadModule(FHandle); inherited; end; @@ -1359,8 +1445,8 @@ procedure T7zPlugin.CreateObject(const clsid, iid: TGUID; var obj); constructor T7zCodec.Create(const lib: string); begin inherited; - FGetMethodProperty := GetProcAddress(FHandle, 'GetMethodProperty'); - FGetNumberOfMethods := GetProcAddress(FHandle, 'GetNumberOfMethods'); + FGetMethodProperty := GetModuleSymbol(FHandle, 'GetMethodProperty'); + FGetNumberOfMethods := GetModuleSymbol(FHandle, 'GetNumberOfMethods'); if not (Assigned(FGetMethodProperty) and Assigned(FGetNumberOfMethods)) then begin FreeLibrary(FHandle); @@ -1519,6 +1605,19 @@ procedure T7zInArchive.ExtractItem(const item: Cardinal; Stream: TStream; test: end; end; +//fix or add by ekot1 +procedure T7zInArchive.ExtractItemToPath(const item: Cardinal; const path: string; test: longbool); stdcall; ++begin + + FExtractPath := IncludeTrailingPathDelimiter(path); + + try + + if test then + + RINOK(FInArchive.Extract(@item, 1, 1, self as IArchiveExtractCallback)) else + + RINOK(FInArchive.Extract(@item, 1, 0, self as IArchiveExtractCallback)); + + finally + + FExtractPath := ''; + + end; + +end; + function T7zInArchive.GetStream(index: Cardinal; var outStream: ISequentialOutStream; askExtractMode: NAskMode): HRESULT; var @@ -1707,6 +1806,7 @@ function T7zInArchive.GetItemCompressedSize(const index: integer): Int64; stdcal Result := Int64(GetItemProp(index, kpidPackSize)); end; +{$IFDEF MSWINDOWS} function T7zInArchive.GetItemFileTime(const index: integer): TFileTime; stdcall; var value: OleVariant; @@ -1717,6 +1817,7 @@ function T7zInArchive.GetItemFileTime(const index: integer): TFileTime; stdcall; Result := TPropVariant(value).filetime; end; end; +{$ENDIF MSWINDOWS} function T7zInArchive.GetItemDataTime(const index: integer): TDateTime; stdcall; var @@ -1793,7 +1894,7 @@ procedure T7zInArchive.SetPassword(const password: UnicodeString); constructor T7zArchive.Create(const lib: string); begin inherited; - FGetHandlerProperty := GetProcAddress(FHandle, 'GetHandlerProperty'); + FGetHandlerProperty := GetModuleSymbol(FHandle, 'GetHandlerProperty'); if not Assigned(FGetHandlerProperty) then begin FreeLibrary(FHandle); From a135d971812cadb073817dec84e7d3560cf4f6ba Mon Sep 17 00:00:00 2001 From: wang80919 Date: Mon, 26 Mar 2018 14:02:38 +0800 Subject: [PATCH 10/10] fix bug --- sevenzip.pas | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/sevenzip.pas b/sevenzip.pas index b620968..5872043 100644 --- a/sevenzip.pas +++ b/sevenzip.pas @@ -1413,7 +1413,7 @@ constructor T7zPlugin.Create(const lib: string); except on E: Exception do begin - raise Exception.CreateFmt('Error loading library %s', [lib] + sLineBreak + 'Error Message: ' + E.Message); + raise Exception.CreateFmt('Error loading library %s' + sLineBreak + 'Error Message: ' + E.Message, [lib]); end; end; end; @@ -1607,16 +1607,16 @@ procedure T7zInArchive.ExtractItem(const item: Cardinal; Stream: TStream; test: //fix or add by ekot1 procedure T7zInArchive.ExtractItemToPath(const item: Cardinal; const path: string; test: longbool); stdcall; -+begin - + FExtractPath := IncludeTrailingPathDelimiter(path); - + try - + if test then - + RINOK(FInArchive.Extract(@item, 1, 1, self as IArchiveExtractCallback)) else - + RINOK(FInArchive.Extract(@item, 1, 0, self as IArchiveExtractCallback)); - + finally - + FExtractPath := ''; - + end; - +end; +begin + FExtractPath := IncludeTrailingPathDelimiter(path); + try + if test then + RINOK(FInArchive.Extract(@item, 1, 1, self as IArchiveExtractCallback)) else + RINOK(FInArchive.Extract(@item, 1, 0, self as IArchiveExtractCallback)); + finally + FExtractPath := ''; + end; +end; function T7zInArchive.GetStream(index: Cardinal; var outStream: ISequentialOutStream; askExtractMode: NAskMode): HRESULT;