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[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
password := 'password';
Result := S_OK;
end;
procedure TMainForm.ExtractClick(Sender: TObject);
begin
with CreateInArchive(CLSID_CFormatZip) do
begin
SetPasswordCallback(nil, PasswordCallback);
SetPassword('password');
OpenFile('c:\test.zip');
...
end;
end;
Writing
-archive
- procedure TMainForm.ExtractAllClick(Sender: TObject);
var
Arch: I7zOutArchive;
begin
Arch := CreateOutArchive(CLSID_CFormat7z);
Arch.AddFile('c:\test.bin', 'folder\test.bin');
Arch.AddFiles('c:\test', 'folder', '*.pas;*.dfm', true);
Arch.AddStream(aStream, soReference, faArchive, CurrentFileTime, CurrentFileTime, 'folder\test.bin', false, false);
SetCompressionLevel(Arch, 5);
SevenZipSetCompressionMethod(Arch, m7BZip2);
Arch.SetProgressCallback(...);
Arch.SetPassword('password');
Arch.SaveToFile('c:\test.zip');
Arch.SaveToStream(aStream);
end;
-
-
\ No newline at end of file
diff --git a/readme.txt b/readme.txt
new file mode 100644
index 0000000..02a0ecf
--- /dev/null
+++ b/readme.txt
@@ -0,0 +1,156 @@
+官网已经找不到了。
+这个地址比较新
+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
+
+
+
+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.2
+
+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, '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(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, 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;
diff --git a/sevenzip.pas b/sevenzip.pas
index 1d7eea9..5872043 100644
--- a/sevenzip.pas
+++ b/sevenzip.pas
@@ -13,13 +13,66 @@
(* 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
+//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;
{$ALIGN ON}
{$MINENUMSIZE 4}
-{$WARN SYMBOL_PLATFORM OFF}
+{$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 刘志林
+ G_7zWorkPath: string; {工作路径，查找dll用}
+
+const
+ //fix by flying wang.
+ kCallBackError = $0FFFFFFF;
+ kCallbackCANCEL = $0FFFFFFE;
+ kCallbackIGNORE = $0FFFFFFD;
+
+
type
PVarType = ^TVarType;
@@ -710,6 +763,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}']
@@ -719,10 +779,18 @@ 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): 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;
@@ -730,13 +798,21 @@ 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;
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]: 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;
end;
@@ -747,7 +823,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;
@@ -810,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
@@ -877,6 +962,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
@@ -885,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;
@@ -907,9 +1051,20 @@ function CurrentFileTime: TFileTime;
begin
GetSystemTimeAsFileTime(Result);
end;
+{$ENDIF MSWINDOWS}
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;
@@ -1021,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
@@ -1071,11 +1270,18 @@ T7zInArchive = class(T7zArchive, I7zInArchive, IProgress, IArchiveOpenCallback
IArchiveExtractCallback, ICryptoGetTextPassword, IArchiveOpenVolumeCallback,
IArchiveOpenSetSubArchiveName)
private
+ //fix by flying wang.
+ FLastWriteFileAttr: 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 +1292,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;
@@ -1094,12 +1302,22 @@ 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): 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;
+ //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 +1360,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 +1389,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;
@@ -1186,10 +1404,20 @@ Result.ClassId := classid;
constructor T7zPlugin.Create(const lib: string);
begin
- FHandle := LoadLibrary(PChar(lib));
+ inherited Create;
+ 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' + sLineBreak + 'Error Message: ' + E.Message, [lib]);
+ end;
+ end;
+ end;
+ FCreateObject := GetModuleSymbol(FHandle, 'CreateObject');
if not (Assigned(FCreateObject)) then
begin
FreeLibrary(FHandle);
@@ -1199,7 +1427,7 @@ constructor T7zPlugin.Create(const lib: string);
destructor T7zPlugin.Destroy;
begin
- FreeLibrary(FHandle);
+ UnloadModule(FHandle);
inherited;
end;
@@ -1217,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);
@@ -1276,6 +1504,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 +1515,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 +1531,14 @@ destructor T7zInArchive.Destroy;
inherited;
end;
+procedure T7zInArchive.ResetLastFileInfo;
+begin
+ //fix by flying wang.
+ FLastWriteFileAttr := faNormal;
+ FLastWriteFileDataTime := MinDateTime;
+ FLastWriteFile := '';
+end;
+
function T7zInArchive.GetInArchive: IInArchive;
begin
if FInArchive = nil then
@@ -1320,6 +1560,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 +1577,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;
@@ -1361,10 +1605,26 @@ 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
path: string;
+ //fix by 刘志林
+ nFileStream: TFileStream;
+ nECR: NECallBack;
begin
if askExtractMode = kExtract then
if FStream <> nil then
@@ -1376,11 +1636,58 @@ function T7zInArchive.GetStream(index: Cardinal;
end else
if FExtractPath <> '' then
begin
- if not GetItemIsFolder(index) then
+ //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);
+ FLastWriteFileAttr := 0;
+ if FileExists(path) then
+ begin
+ FLastWriteFileAttr := FileGetAttr(path);
+ if FLastWriteFileAttr <> 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
+ if nECR = EC_CANCEL then
+ begin
+ Result := kCallbackCANCEL;
+ Exit;
+ end;
+ end
+ else
+ begin
+ FreeAndNil(nFileStream);
+ FLastWriteFileDataTime := GetItemDataTime(index);
+ FLastWriteFile := path;
+ if (FLastWriteFileAttr <> 0) and (FLastWriteFileAttr <> faNormal) then
+ FileSetAttr(FLastWriteFile, FLastWriteFileAttr);
+ FileSetDate(FLastWriteFile, DateTimeToFileDate(FLastWriteFileDataTime));
+ outStream := T7zStream.Create(TFileStream.Create(path, fmCreate), soOwned);
+ end;
end;
end;
Result := S_OK;
@@ -1393,6 +1700,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 +1715,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 (FLastWriteFileAttr <> 0) and (FLastWriteFileAttr <> faNormal) then
+ FileSetAttr(FLastWriteFile, FLastWriteFileAttr);
+ 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 +1751,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
@@ -1474,9 +1795,37 @@ 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 := Int64(GetItemProp(index, kpidSize));
+end;
+
+//fix by flying wang.
+function T7zInArchive.GetItemCompressedSize(const index: integer): Int64; stdcall;
+begin
+ Result := Int64(GetItemProp(index, kpidPackSize));
+end;
+
+{$IFDEF MSWINDOWS}
+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;
+{$ENDIF MSWINDOWS}
+
+function T7zInArchive.GetItemDataTime(const index: integer): TDateTime; stdcall;
+var
+ A: TFileTime;
begin
- Result := Cardinal(GetItemProp(index, kpidSize));
+ Result := MinDateTime;
+ A := GetItemFileTime(index);
+ Result := FileTimeToDateTime(A);
end;
procedure T7zInArchive.ExtractItems(items: PCardArray; count: cardinal; test: longbool;
@@ -1501,6 +1850,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
@@ -1537,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);
@@ -1658,7 +2015,7 @@ T7zBatchItem = class
IsFolder, IsAnti: boolean;
FileName: TFileName;
Ownership: TStreamOwnership;
- Size: Cardinal;
+ Size: Int64;
destructor Destroy; override;
end;
@@ -1675,6 +2032,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;
@@ -1684,16 +2043,20 @@ 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));
+ //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 +2066,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 +2080,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 +2101,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 +2226,21 @@ 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;
kpidIsAnti: value := item.IsAnti;
else
// beep(0,0);
@@ -1901,6 +2300,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 +2338,17 @@ 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 := '';
+
+//finalization
+
+
end.