mirror of
https://github.com/doublecmd/doublecmd.git
synced 2026-06-21 09:58:13 +00:00
FIX: Pack/delete progress
FIX: Exception at second pack/delete operation
This commit is contained in:
Alexander Koblov
parent
7f51aaeb7a
commit
4c502ec3f1
4 changed files with 158 additions and 68 deletions
|
|
@ -287,7 +287,7 @@ var
|
|||
begin
|
||||
// Try to find archive type in cache
|
||||
if UpdateFormatsCache.ArchiveName = AFileName then
|
||||
Exit(TJclUpdateArchiveClassArray(DecompressFormatsCache.ArchiveClassArray))
|
||||
Exit(TJclUpdateArchiveClassArray(UpdateFormatsCache.ArchiveClassArray))
|
||||
else begin
|
||||
UpdateFormatsCache.ArchiveName:= AFileName;
|
||||
SetLength(UpdateFormatsCache.ArchiveClassArray, 0);
|
||||
|
|
@ -307,7 +307,7 @@ var
|
|||
begin
|
||||
// Try to find archive type in cache
|
||||
if CompressFormatsCache.ArchiveName = AFileName then
|
||||
Exit(TJclCompressArchiveClassArray(DecompressFormatsCache.ArchiveClassArray))
|
||||
Exit(TJclCompressArchiveClassArray(CompressFormatsCache.ArchiveClassArray))
|
||||
else begin
|
||||
CompressFormatsCache.ArchiveName:= AFileName;
|
||||
SetLength(CompressFormatsCache.ArchiveClassArray, 0);
|
||||
|
|
|
|||
|
|
@ -49,7 +49,7 @@ implementation
|
|||
|
||||
uses
|
||||
JwaWinBase, Windows, SysUtils, Classes, JclCompression, SevenZip, SevenZipAdv,
|
||||
SevenZipDlg, SevenZipLng, SevenZipOpt, LazFileUtils;
|
||||
SevenZipDlg, SevenZipLng, SevenZipOpt, LazFileUtils, SyncObjs;
|
||||
|
||||
type
|
||||
|
||||
|
|
@ -61,7 +61,17 @@ type
|
|||
|
||||
{ TSevenZipUpdate }
|
||||
|
||||
TSevenZipUpdate = class
|
||||
TSevenZipUpdate = class(TThread)
|
||||
FPercent: Int64;
|
||||
FProgress: TSimpleEvent;
|
||||
FArchive: TJclCompressionArchive;
|
||||
public
|
||||
constructor Create; overload;
|
||||
constructor Create(Archive: TJclCompressionArchive); overload;
|
||||
destructor Destroy; override;
|
||||
public
|
||||
procedure Execute; override;
|
||||
function Update: Integer; virtual;
|
||||
procedure JclCompressionPassword(Sender: TObject; var Password: WideString);
|
||||
procedure JclCompressionProgress(Sender: TObject; const Value, MaxValue: Int64); virtual;
|
||||
end;
|
||||
|
|
@ -77,9 +87,11 @@ type
|
|||
ArchiveName: UTF8String;
|
||||
ProcessArray: TCardinalArray;
|
||||
FileName: array of UTF8String;
|
||||
Archive: TJclDecompressArchive;
|
||||
ProcessDataProc: TProcessDataProcW;
|
||||
public
|
||||
procedure Execute; override;
|
||||
function Update: Integer; override;
|
||||
procedure SetArchive(AValue: TJclDecompressArchive);
|
||||
procedure JclCompressionProgress(Sender: TObject; const Value, MaxValue: Int64); override;
|
||||
function JclCompressionExtract(Sender: TObject; AIndex: Integer;
|
||||
var AFileName: TFileName; var Stream: TStream; var AOwnsStream: Boolean): Boolean;
|
||||
|
|
@ -115,11 +127,12 @@ end;
|
|||
function OpenArchiveW(var ArchiveData : tOpenArchiveDataW) : TArcHandle; stdcall;
|
||||
var
|
||||
I: Integer;
|
||||
Handle: TSevenZipHandle;
|
||||
ResultHandle: TSevenZipHandle;
|
||||
Archive: TJclDecompressArchive;
|
||||
AFormats: TJclDecompressArchiveClassArray;
|
||||
begin
|
||||
Handle:= TSevenZipHandle.Create;
|
||||
with Handle do
|
||||
ResultHandle:= TSevenZipHandle.Create;
|
||||
with ResultHandle do
|
||||
begin
|
||||
Index:= 0;
|
||||
ProcessIndex:= 0;
|
||||
|
|
@ -130,10 +143,8 @@ begin
|
|||
begin
|
||||
Archive := AFormats[I].Create(ArchiveName, 0, False);
|
||||
try
|
||||
Archive.OnPassword:= JclCompressionPassword;
|
||||
Archive.OnProgress := JclCompressionProgress;
|
||||
SetArchive(Archive);
|
||||
|
||||
Archive.OnExtract:= JclCompressionExtract;
|
||||
Archive.ListFiles;
|
||||
|
||||
Count:= Archive.ItemCount;
|
||||
|
|
@ -146,7 +157,7 @@ begin
|
|||
|
||||
ArchiveData.OpenResult:= E_SUCCESS;
|
||||
|
||||
Exit(TArcHandle(Handle));
|
||||
Exit(TArcHandle(ResultHandle));
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
|
|
@ -169,7 +180,7 @@ begin
|
|||
with Handle do
|
||||
begin
|
||||
if Index >= Count then Exit(E_END_ARCHIVE);
|
||||
Item:= Archive.Items[Index];
|
||||
Item:= FArchive.Items[Index];
|
||||
HeaderData.FileName:= Item.PackedName;
|
||||
HeaderData.UnpSize:= Int64Rec(Item.FileSize).Lo;
|
||||
HeaderData.UnpSizeHigh:= Int64Rec(Item.FileSize).Hi;
|
||||
|
|
@ -226,16 +237,14 @@ var
|
|||
begin
|
||||
Result:= E_SUCCESS;
|
||||
if (hArcData <> wcxInvalidHandle) then
|
||||
with Handle do begin
|
||||
with Handle do
|
||||
begin
|
||||
if OpenMode = PK_OM_EXTRACT then
|
||||
try
|
||||
SetLength(ProcessArray, ProcessIndex);
|
||||
TJclSevenzipDecompressArchive(Archive).ProcessSelected(ProcessArray, OperationMode = PK_TEST);
|
||||
except
|
||||
on E: Exception do
|
||||
Result:= GetArchiveError(E);
|
||||
begin
|
||||
Start;
|
||||
Result:= Update;
|
||||
end;
|
||||
Archive.Free;
|
||||
FArchive.Free;
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
|
@ -282,9 +291,7 @@ begin
|
|||
begin
|
||||
Archive := AFormats[I].Create(FileNameUTF8, 0, False);
|
||||
try
|
||||
AProgress:= TSevenZipUpdate.Create;
|
||||
Archive.OnPassword:= AProgress.JclCompressionPassword;
|
||||
Archive.OnProgress:= AProgress.JclCompressionProgress;
|
||||
AProgress:= TSevenZipUpdate.Create(Archive);
|
||||
|
||||
if (Flags and PK_PACK_ENCRYPT) <> 0 then
|
||||
begin
|
||||
|
|
@ -328,13 +335,9 @@ begin
|
|||
Break;
|
||||
Inc(AddList, Length(FileName) + 1);
|
||||
end;
|
||||
try
|
||||
Archive.Compress;
|
||||
except
|
||||
on E: Exception do
|
||||
Exit(GetArchiveError(E));
|
||||
end;
|
||||
Exit(E_SUCCESS);
|
||||
|
||||
AProgress.Start;
|
||||
Exit(AProgress.Update);
|
||||
finally
|
||||
Archive.Free;
|
||||
AProgress.Free;
|
||||
|
|
@ -360,9 +363,7 @@ begin
|
|||
begin
|
||||
Archive := AFormats[I].Create(FileNameUTF8, 0, False);
|
||||
try
|
||||
AProgress:= TSevenZipUpdate.Create;
|
||||
Archive.OnPassword:= AProgress.JclCompressionPassword;
|
||||
Archive.OnProgress:= AProgress.JclCompressionProgress;
|
||||
AProgress:= TSevenZipUpdate.Create(Archive);
|
||||
|
||||
try
|
||||
Archive.ListFiles;
|
||||
|
|
@ -386,13 +387,9 @@ begin
|
|||
if FileList^ = #0 then
|
||||
Break; // end of list
|
||||
end;
|
||||
try
|
||||
Archive.Compress;
|
||||
except
|
||||
on E: Exception do
|
||||
Exit(GetArchiveError(E));
|
||||
end;
|
||||
Exit(E_SUCCESS);
|
||||
|
||||
AProgress.Start;
|
||||
Exit(AProgress.Update);
|
||||
finally
|
||||
Archive.Free;
|
||||
AProgress.Free;
|
||||
|
|
@ -446,6 +443,55 @@ end;
|
|||
|
||||
{ TSevenZipUpdate }
|
||||
|
||||
constructor TSevenZipUpdate.Create;
|
||||
begin
|
||||
inherited Create(True);
|
||||
FProgress:= TSimpleEvent.Create;
|
||||
end;
|
||||
|
||||
constructor TSevenZipUpdate.Create(Archive: TJclCompressionArchive);
|
||||
begin
|
||||
inherited Create(True);
|
||||
FArchive:= Archive;
|
||||
Archive.Tag:= Self;
|
||||
FProgress:= TSimpleEvent.Create;
|
||||
Archive.OnPassword:= JclCompressionPassword;
|
||||
Archive.OnProgress:= JclCompressionProgress;
|
||||
end;
|
||||
|
||||
destructor TSevenZipUpdate.Destroy;
|
||||
begin
|
||||
FProgress.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TSevenZipUpdate.Execute;
|
||||
begin
|
||||
try
|
||||
(FArchive as TJclCompressArchive).Compress;
|
||||
ReturnValue:= E_SUCCESS;
|
||||
except
|
||||
on E: Exception do
|
||||
ReturnValue:= GetArchiveError(E);
|
||||
end;
|
||||
Terminate;
|
||||
FProgress.SetEvent;
|
||||
end;
|
||||
|
||||
function TSevenZipUpdate.Update: Integer;
|
||||
var
|
||||
AllowCancel: Boolean;
|
||||
begin
|
||||
AllowCancel:= not (FArchive is TJclUpdateArchive);
|
||||
while not Terminated do
|
||||
begin
|
||||
FProgress.WaitFor(INFINITE);
|
||||
// If the user has clicked on Cancel, the function returns zero
|
||||
FArchive.CancelCurrentOperation:= (ProcessDataProcT(PWideChar(FArchive.Items[FArchive.CurrentItemIndex].PackedName), -FPercent) = 0) and AllowCancel;
|
||||
end;
|
||||
Result:= ReturnValue;
|
||||
end;
|
||||
|
||||
procedure TSevenZipUpdate.JclCompressionPassword(Sender: TObject;
|
||||
var Password: WideString);
|
||||
var
|
||||
|
|
@ -455,33 +501,65 @@ begin
|
|||
raise ESevenZipAbort.Create(EmptyStr);
|
||||
end;
|
||||
|
||||
procedure TSevenZipUpdate.JclCompressionProgress(Sender: TObject; const Value,
|
||||
MaxValue: Int64);
|
||||
procedure TSevenZipUpdate.JclCompressionProgress(Sender: TObject; const Value, MaxValue: Int64);
|
||||
var
|
||||
Percent: Int64;
|
||||
Progress: TSevenZipUpdate;
|
||||
Archive: TJclUpdateArchive absolute Sender;
|
||||
begin
|
||||
if Assigned(ProcessDataProcT) then
|
||||
begin
|
||||
Percent:= 1000 + (Value * 100) div MaxValue;
|
||||
// If the user has clicked on Cancel, the function returns zero
|
||||
Archive.CancelCurrentOperation:= ProcessDataProcT(PWideChar(Archive.Items[Archive.CurrentItemIndex].PackedName), -Percent) = 0;
|
||||
end;
|
||||
Progress:= TSevenZipUpdate(Archive.Tag);
|
||||
Progress.FPercent:= 1000 + (Value * 100) div MaxValue;
|
||||
Progress.FProgress.SetEvent;
|
||||
end;
|
||||
|
||||
{ TSevenZipHandle }
|
||||
|
||||
procedure TSevenZipHandle.JclCompressionProgress(Sender: TObject; const Value,
|
||||
MaxValue: Int64);
|
||||
procedure TSevenZipHandle.Execute;
|
||||
begin
|
||||
try
|
||||
SetLength(ProcessArray, ProcessIndex);
|
||||
TJclSevenzipDecompressArchive(FArchive).ProcessSelected(ProcessArray, OperationMode = PK_TEST);
|
||||
ReturnValue:= E_SUCCESS;
|
||||
except
|
||||
on E: Exception do
|
||||
ReturnValue:= GetArchiveError(E);
|
||||
end;
|
||||
Terminate;
|
||||
FProgress.SetEvent;
|
||||
end;
|
||||
|
||||
function TSevenZipHandle.Update: Integer;
|
||||
begin
|
||||
while not Terminated do
|
||||
begin
|
||||
FProgress.WaitFor(INFINITE);
|
||||
if Assigned(ProcessDataProc) then
|
||||
begin
|
||||
// If the user has clicked on Cancel, the function returns zero
|
||||
FArchive.CancelCurrentOperation:= ProcessDataProc(PWideChar(FArchive.Items[FArchive.CurrentItemIndex].PackedName), -FPercent) = 0;
|
||||
end;
|
||||
end;
|
||||
Result:= ReturnValue;
|
||||
end;
|
||||
|
||||
procedure TSevenZipHandle.SetArchive(AValue: TJclDecompressArchive);
|
||||
begin
|
||||
FArchive:= AValue;
|
||||
FArchive.Tag:= Self;
|
||||
AValue.OnPassword := JclCompressionPassword;
|
||||
AValue.OnProgress := JclCompressionProgress;
|
||||
AValue.OnExtract := JclCompressionExtract;
|
||||
end;
|
||||
|
||||
procedure TSevenZipHandle.JclCompressionProgress(Sender: TObject; const Value, MaxValue: Int64);
|
||||
var
|
||||
Percent: Int64;
|
||||
Progress: TSevenZipHandle;
|
||||
Archive: TJclDecompressArchive absolute Sender;
|
||||
begin
|
||||
if Assigned(ProcessDataProc) then
|
||||
begin
|
||||
Percent:= 1000 + (Value * 100) div MaxValue;
|
||||
// If the user has clicked on Cancel, the function returns zero
|
||||
Archive.CancelCurrentOperation:= ProcessDataProc(PWideChar(Archive.Items[Archive.CurrentItemIndex].PackedName), -Percent) = 0;
|
||||
Progress:= TSevenZipHandle(Archive.Tag);
|
||||
Progress.FPercent:= 1000 + (Value * 100) div MaxValue;
|
||||
Progress.FProgress.SetEvent;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
|
|
|||
|
|
@ -778,6 +778,7 @@ type
|
|||
{ TJclCompressionArchive is not ref-counted }
|
||||
TJclCompressionArchive = class(TInterfacedObject, IInterface)
|
||||
private
|
||||
FTag: Pointer;
|
||||
FOnProgress: TJclCompressionProgressEvent;
|
||||
FOnRatio: TJclCompressionRatioEvent;
|
||||
FOnVolume: TJclCompressionVolumeEvent;
|
||||
|
|
@ -873,6 +874,7 @@ type
|
|||
|
||||
property SupportsNestedArchive: Boolean read GetSupportsNestedArchive;
|
||||
property CancelCurrentOperation: Boolean read FCancelCurrentOperation write FCancelCurrentOperation;
|
||||
property Tag: Pointer read FTag write FTag;
|
||||
end;
|
||||
|
||||
TJclCompressionArchiveClass = class of TJclCompressionArchive;
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
jcl/source/common/JclCompression.pas | 45 ++++++++++++++++++++++++++++++------
|
||||
jcl/source/windows/sevenzip.pas | 8 +++----
|
||||
2 files changed, 42 insertions(+), 11 deletions(-)
|
||||
jcl/source/common/JclCompression.pas | 47 ++++++++++++++++++++++++++++++------
|
||||
jcl/source/windows/sevenzip.pas | 8 +++---
|
||||
2 files changed, 44 insertions(+), 11 deletions(-)
|
||||
|
||||
diff --git a/jcl/source/common/JclCompression.pas b/jcl/source/common/JclCompression.pas
|
||||
index e5e6a2f..9fcf6f8 100644
|
||||
index e5e6a2f..6cde31b 100644
|
||||
--- a/jcl/source/common/JclCompression.pas
|
||||
+++ b/jcl/source/common/JclCompression.pas
|
||||
@@ -44,8 +44,7 @@
|
||||
|
|
@ -68,7 +68,12 @@ index e5e6a2f..9fcf6f8 100644
|
|||
|
||||
TJclCompressionItemProperty = (ipPackedName, ipPackedSize, ipPackedExtension,
|
||||
ipFileSize, ipFileName, ipAttributes, ipCreationTime, ipLastAccessTime,
|
||||
@@ -770,6 +782,7 @@ type
|
||||
@@ -766,10 +778,12 @@ type
|
||||
{ TJclCompressionArchive is not ref-counted }
|
||||
TJclCompressionArchive = class(TInterfacedObject, IInterface)
|
||||
private
|
||||
+ FTag: Pointer;
|
||||
FOnProgress: TJclCompressionProgressEvent;
|
||||
FOnRatio: TJclCompressionRatioEvent;
|
||||
FOnVolume: TJclCompressionVolumeEvent;
|
||||
FOnVolumeMaxSize: TJclCompressionVolumeMaxSizeEvent;
|
||||
|
|
@ -76,7 +81,7 @@ index e5e6a2f..9fcf6f8 100644
|
|||
FPassword: WideString;
|
||||
FVolumeIndex: Integer;
|
||||
FVolumeIndexOffset: Integer;
|
||||
@@ -855,6 +868,7 @@ type
|
||||
@@ -855,10 +869,12 @@ type
|
||||
property OnVolume: TJclCompressionVolumeEvent read FOnVolume write FOnVolume;
|
||||
property OnVolumeMaxSize: TJclCompressionVolumeMaxSizeEvent read FOnVolumeMaxSize
|
||||
write FOnVolumeMaxSize;
|
||||
|
|
@ -84,7 +89,12 @@ index e5e6a2f..9fcf6f8 100644
|
|||
property Password: WideString read FPassword write FPassword;
|
||||
|
||||
property SupportsNestedArchive: Boolean read GetSupportsNestedArchive;
|
||||
@@ -2206,8 +2220,7 @@ const
|
||||
property CancelCurrentOperation: Boolean read FCancelCurrentOperation write FCancelCurrentOperation;
|
||||
+ property Tag: Pointer read FTag write FTag;
|
||||
end;
|
||||
|
||||
TJclCompressionArchiveClass = class of TJclCompressionArchive;
|
||||
@@ -2206,8 +2222,7 @@ const
|
||||
implementation
|
||||
|
||||
uses
|
||||
|
|
@ -94,7 +104,7 @@ index e5e6a2f..9fcf6f8 100644
|
|||
|
||||
const
|
||||
JclDefaultBufferSize = 131072; // 128k
|
||||
@@ -2218,6 +2231,8 @@ var
|
||||
@@ -2218,6 +2233,8 @@ var
|
||||
GlobalStreamFormats: TObject;
|
||||
GlobalArchiveFormats: TObject;
|
||||
|
||||
|
|
@ -103,7 +113,7 @@ index e5e6a2f..9fcf6f8 100644
|
|||
//=== { TJclCompressionStream } ==============================================
|
||||
|
||||
constructor TJclCompressionStream.Create(AStream: TStream);
|
||||
@@ -3743,6 +3758,8 @@ begin
|
||||
@@ -3743,6 +3760,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
|
@ -112,7 +122,7 @@ index e5e6a2f..9fcf6f8 100644
|
|||
{$IFDEF MSWINDOWS}
|
||||
|
||||
function OpenFileStream(const FileName: TFileName; StreamAccess: TJclStreamAccess): TStream;
|
||||
@@ -3887,7 +3904,7 @@ end;
|
||||
@@ -3887,7 +3906,7 @@ end;
|
||||
function TJclCompressionItem.GetNestedArchiveName: WideString;
|
||||
var
|
||||
ParentArchiveExtension, ArchiveFileName, ArchiveExtension: WideString;
|
||||
|
|
@ -121,7 +131,7 @@ index e5e6a2f..9fcf6f8 100644
|
|||
begin
|
||||
if ipPackedName in ValidProperties then
|
||||
Result := PackedName
|
||||
@@ -3914,7 +3931,7 @@ begin
|
||||
@@ -3914,7 +3933,7 @@ begin
|
||||
else
|
||||
if ArchiveFileName <> '' then
|
||||
begin
|
||||
|
|
@ -130,7 +140,7 @@ index e5e6a2f..9fcf6f8 100644
|
|||
try
|
||||
ExtensionMap.Delimiter := ';';
|
||||
ExtensionMap.DelimitedText := Archive.ArchiveSubExtensions;
|
||||
@@ -7422,7 +7439,14 @@ function TJclSevenzipOpenCallback.CryptoGetTextPassword(
|
||||
@@ -7422,7 +7441,14 @@ function TJclSevenzipOpenCallback.CryptoGetTextPassword(
|
||||
password: PBStr): HRESULT;
|
||||
begin
|
||||
if Assigned(password) then
|
||||
|
|
@ -145,7 +155,7 @@ index e5e6a2f..9fcf6f8 100644
|
|||
Result := S_OK;
|
||||
end;
|
||||
|
||||
@@ -7456,7 +7480,14 @@ function TJclSevenzipExtractCallback.CryptoGetTextPassword(
|
||||
@@ -7456,7 +7482,14 @@ function TJclSevenzipExtractCallback.CryptoGetTextPassword(
|
||||
password: PBStr): HRESULT;
|
||||
begin
|
||||
if Assigned(password) then
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue