mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-17 12:39:25 +02:00
* Allow termination of lengthy operations
git-svn-id: trunk@35517 -
This commit is contained in:
michael
parent
236e56dee0
commit
f2f2e02b06
@ -198,6 +198,7 @@ Const
|
||||
Type
|
||||
|
||||
TProgressEvent = Procedure(Sender : TObject; Const Pct : Double) of object;
|
||||
TProgressEventEx = Procedure(Sender : TObject; Const ATotPos, ATotSize: Int64) of object;
|
||||
TOnEndOfFileEvent = Procedure(Sender : TObject; Const Ratio : Double) of object;
|
||||
TOnStartFileEvent = Procedure(Sender : TObject; Const AFileName : String) of object;
|
||||
|
||||
@ -205,6 +206,8 @@ Type
|
||||
|
||||
{ TCompressor }
|
||||
TCompressor = Class(TObject)
|
||||
private
|
||||
FTerminated: Boolean;
|
||||
Protected
|
||||
FInFile : TStream; { I/O file variables }
|
||||
FOutFile : TStream;
|
||||
@ -219,10 +222,12 @@ Type
|
||||
Class Function ZipID : Word; virtual; Abstract;
|
||||
Class Function ZipVersionReqd: Word; virtual; Abstract;
|
||||
Function ZipBitFlag: Word; virtual; Abstract;
|
||||
Procedure Terminate;
|
||||
Property BufferSize : LongWord read FBufferSize;
|
||||
Property OnPercent : Integer Read FOnPercent Write FOnPercent;
|
||||
Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
|
||||
Property Crc32Val : LongWord Read FCrc32Val Write FCrc32Val;
|
||||
Property Terminated : Boolean Read FTerminated;
|
||||
end;
|
||||
|
||||
{ TDeCompressor }
|
||||
@ -234,15 +239,22 @@ Type
|
||||
FBufferSize : LongWord;
|
||||
FOnPercent : Integer;
|
||||
FOnProgress : TProgressEvent;
|
||||
FOnProgressEx: TProgressEventEx;
|
||||
FTotPos : Int64;
|
||||
FTotSize : Int64;
|
||||
FTerminated : Boolean;
|
||||
Procedure UpdC32(Octet: Byte);
|
||||
Public
|
||||
Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); virtual;
|
||||
Procedure DeCompress; Virtual; Abstract;
|
||||
Procedure Terminate;
|
||||
Class Function ZipID : Word; virtual; Abstract;
|
||||
Property BufferSize : LongWord read FBufferSize;
|
||||
Property OnPercent : Integer Read FOnPercent Write FOnPercent;
|
||||
Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
|
||||
Property OnProgressEx : TProgressEventEx Read FOnProgressEx Write FOnProgressEx;
|
||||
Property Crc32Val : LongWord Read FCrc32Val Write FCrc32Val;
|
||||
Property Terminated : Boolean Read FTerminated;
|
||||
end;
|
||||
|
||||
{ TShrinker }
|
||||
@ -401,6 +413,7 @@ Type
|
||||
TZipper = Class(TObject)
|
||||
Private
|
||||
FEntries : TZipFileEntries;
|
||||
FTerminated: Boolean;
|
||||
FZipping : Boolean;
|
||||
FBufSize : LongWord;
|
||||
FFileName : RawByteString; { Name of resulting Zip file }
|
||||
@ -419,6 +432,7 @@ Type
|
||||
FOnProgress : TProgressEvent;
|
||||
FOnEndOfFile : TOnEndOfFileEvent;
|
||||
FOnStartFile : TOnStartFileEvent;
|
||||
FCurrentCompressor : TCompressor;
|
||||
function CheckEntries: Integer;
|
||||
procedure SetEntries(const AValue: TZipFileEntries);
|
||||
Protected
|
||||
@ -449,6 +463,7 @@ Type
|
||||
Procedure ZipFiles(AFileName : RawByteString; Entries : TZipFileEntries);
|
||||
Procedure ZipFiles(Entries : TZipFileEntries);
|
||||
Procedure Clear;
|
||||
Procedure Terminate;
|
||||
Public
|
||||
Property BufferSize : LongWord Read FBufSize Write SetBufSize;
|
||||
Property OnPercent : Integer Read FOnPercent Write FOnPercent;
|
||||
@ -461,6 +476,7 @@ Type
|
||||
Property Files : TStrings Read FFiles; deprecated;
|
||||
Property InMemSize : Int64 Read FInMemSize Write FInMemSize;
|
||||
Property Entries : TZipFileEntries Read FEntries Write SetEntries;
|
||||
Property Terminated : Boolean Read FTerminated;
|
||||
end;
|
||||
|
||||
{ TFullZipFileEntry }
|
||||
@ -511,11 +527,17 @@ Type
|
||||
LocalHdr : Local_File_Header_Type; //Local header, before compressed file data
|
||||
LocalZip64Fld : Zip64_Extended_Info_Field_Type; //header is in LocalZip64ExtHdr
|
||||
CentralHdr : Central_File_Header_Type;
|
||||
|
||||
FTotPos : Int64;
|
||||
FTotSize : Int64;
|
||||
FTerminated: Boolean;
|
||||
FOnPercent : LongInt;
|
||||
FOnProgress : TProgressEvent;
|
||||
FOnProgressEx : TProgressEventEx;
|
||||
FOnEndOfFile : TOnEndOfFileEvent;
|
||||
FOnStartFile : TOnStartFileEvent;
|
||||
FCurrentDecompressor: TDecompressor;
|
||||
function CalcTotalSize(AllFiles: Boolean): Int64;
|
||||
function IsMatch(I: TFullZipFileEntry): Boolean;
|
||||
Protected
|
||||
Procedure OpenInput;
|
||||
Procedure CloseOutput(Item : TFullZipFileEntry; var OutStream: TStream);
|
||||
@ -543,6 +565,7 @@ Type
|
||||
Procedure UnZipAllFiles(AFileName : RawByteString);
|
||||
Procedure Clear;
|
||||
Procedure Examine;
|
||||
Procedure Terminate;
|
||||
Public
|
||||
Property BufferSize : LongWord Read FBufSize Write SetBufSize;
|
||||
Property OnOpenInputStream: TCustomInputStreamEvent read FOnOpenInputStream write FOnOpenInputStream;
|
||||
@ -551,6 +574,7 @@ Type
|
||||
Property OnDoneStream : TOnCustomStreamEvent Read FOnDoneStream Write FOnDoneStream;
|
||||
Property OnPercent : Integer Read FOnPercent Write FOnPercent;
|
||||
Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
|
||||
Property OnProgressEx : TProgressEventEx Read FOnProgressEx Write FOnProgressEx;
|
||||
Property OnStartFile : TOnStartFileEvent Read FOnStartFile Write FOnStartFile;
|
||||
Property OnEndFile : TOnEndOfFileEvent Read FOnEndOfFile Write FOnEndOfFile;
|
||||
Property FileName : RawByteString Read FFileName Write SetFileName;
|
||||
@ -559,6 +583,7 @@ Type
|
||||
Property Files : TStrings Read FFiles;
|
||||
Property Entries : TFullZipFileEntries Read FEntries;
|
||||
Property UseUTF8 : Boolean Read FUseUTF8 Write FUseUTF8;
|
||||
Property Terminated : Boolean Read FTerminated;
|
||||
end;
|
||||
|
||||
EZipError = Class(Exception);
|
||||
@ -849,6 +874,11 @@ begin
|
||||
CRC32Val:=$FFFFFFFF;
|
||||
end;
|
||||
|
||||
procedure TDeCompressor.Terminate;
|
||||
begin
|
||||
FTerminated:=True;
|
||||
end;
|
||||
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
TCompressor
|
||||
@ -869,6 +899,11 @@ begin
|
||||
CRC32Val:=$FFFFFFFF;
|
||||
end;
|
||||
|
||||
procedure TCompressor.Terminate;
|
||||
begin
|
||||
FTerminated:=True;
|
||||
end;
|
||||
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
TDeflater
|
||||
@ -918,7 +953,7 @@ begin
|
||||
FOnProgress(self,100 * ( BytesNow / FSize));
|
||||
inc(NextMark,OnBytes);
|
||||
end;
|
||||
Until (Count=0);
|
||||
Until (Count=0) or Terminated;
|
||||
Finally
|
||||
C.Free;
|
||||
end;
|
||||
@ -998,9 +1033,12 @@ begin
|
||||
begin
|
||||
if (FSize>0) and assigned(FOnProgress) Then
|
||||
FOnProgress(self,100 * ( BytesNow / FSize));
|
||||
if assigned(FOnProgressEx) Then
|
||||
FOnProgressEx(Self, FTotPos + BytesNow, FTotSize);
|
||||
inc(NextMark,OnBytes);
|
||||
end;
|
||||
Until (Count=0);
|
||||
Until (Count=0) or Terminated;
|
||||
FTotPos := FTotPos + FOutFile.Size;
|
||||
Finally
|
||||
C.Free;
|
||||
end;
|
||||
@ -1009,6 +1047,8 @@ begin
|
||||
end;
|
||||
if assigned(FOnProgress) then
|
||||
fOnProgress(self,100.0);
|
||||
if assigned(FOnProgressEx) then
|
||||
FOnProgressEx(Self, FTotPos, FTotSize);
|
||||
Crc32Val:=NOT Crc32Val;
|
||||
end;
|
||||
|
||||
@ -1797,6 +1837,7 @@ Function TZipper.CreateCompressor(Item : TZipFileEntry; AInFile,AZipStream : TSt
|
||||
begin
|
||||
Result:=TDeflater.Create(AinFile,AZipStream,FBufSize);
|
||||
(Result as TDeflater).CompressionLevel:=Item.CompressionLevel;
|
||||
FCurrentCompressor:=Result;
|
||||
end;
|
||||
|
||||
Procedure TZipper.ZipOneFile(Item : TZipFileEntry);
|
||||
@ -1833,6 +1874,7 @@ Begin
|
||||
ZVersionReqd:=ZipVersionReqd;
|
||||
ZBitFlag:=ZipBitFlag;
|
||||
Finally
|
||||
FCurrentCompressor:=Nil;
|
||||
Free;
|
||||
end;
|
||||
If UpdateZipHeader(Item,ZipStream,CRC,ZMethod,ZVersionReqd,ZBitFlag) then
|
||||
@ -1877,15 +1919,20 @@ procedure TZipper.SaveToStream(AStream: TStream);
|
||||
Var
|
||||
I : integer; //could be qword but limited by FEntries.Count
|
||||
begin
|
||||
FTerminated:=False;
|
||||
FOutStream := AStream;
|
||||
If CheckEntries=0 then
|
||||
Exit;
|
||||
FZipping:=True;
|
||||
Try
|
||||
GetFileInfo; //get info on file entries in zip
|
||||
for I:=0 to FEntries.Count-1 do
|
||||
I:=0;
|
||||
While (I<FEntries.Count) and not Terminated do
|
||||
begin
|
||||
ZipOneFile(FEntries[i]);
|
||||
if FEntries.Count>0 then
|
||||
Inc(I);
|
||||
end;
|
||||
if (FEntries.Count>0) and not Terminated then
|
||||
BuildZipDirectory;
|
||||
finally
|
||||
FZipping:=False;
|
||||
@ -2005,6 +2052,13 @@ begin
|
||||
FFiles.Clear;
|
||||
end;
|
||||
|
||||
procedure TZipper.Terminate;
|
||||
begin
|
||||
FTerminated:=True;
|
||||
if Assigned(FCurrentCompressor) then
|
||||
FCurrentCompressor.Terminate;
|
||||
end;
|
||||
|
||||
Destructor TZipper.Destroy;
|
||||
|
||||
begin
|
||||
@ -2475,6 +2529,7 @@ begin
|
||||
else
|
||||
raise EZipError.CreateFmt(SErrUnsupportedCompressionFormat,[AMethod]);
|
||||
end;
|
||||
FCurrentDecompressor:=Result;
|
||||
end;
|
||||
|
||||
procedure TUnZipper.UnZipOneFile(Item: TFullZipFileEntry);
|
||||
@ -2536,12 +2591,19 @@ Var
|
||||
else
|
||||
With CreateDecompressor(Item, ZMethod, FZipStream, Dest) do
|
||||
Try
|
||||
FTotPos := Self.FTotPos;
|
||||
FTotSize := Self.FTotSize;
|
||||
OnProgress:=Self.OnProgress;
|
||||
OnProgressEx := Self.OnProgressEx;
|
||||
OnPercent:=Self.OnPercent;
|
||||
OnProgress:=Self.OnProgress;
|
||||
OnPercent:=Self.OnPercent;
|
||||
DeCompress;
|
||||
Self.FTotPos := FTotPos;
|
||||
if Item.CRC32 <> Crc32Val then
|
||||
raise EZipError.CreateFmt(SErrInvalidCRC,[Item.ArchiveFileName]);
|
||||
Finally
|
||||
FCurrentDecompressor:=Nil;
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
@ -2631,17 +2693,33 @@ Begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TUnZipper.IsMatch(I : TFullZipFileEntry) : Boolean;
|
||||
|
||||
begin
|
||||
if UseUTF8 then
|
||||
Result:=(FFiles.IndexOf(I.UTF8ArchiveFileName)<>-1)
|
||||
else
|
||||
Result:=(FFiles.IndexOf(I.ArchiveFileName)<>-1)
|
||||
end;
|
||||
|
||||
Function TUnZipper.CalcTotalSize(AllFiles : Boolean) : Int64;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
Item : TFullZipFileEntry;
|
||||
|
||||
begin
|
||||
Result:=0;
|
||||
for i:=0 to FEntries.Count-1 do
|
||||
begin
|
||||
Item := FEntries[i];
|
||||
if AllFiles or IsMatch(Item) then
|
||||
Result := Result + TZipFileEntry(Item).Size;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TUnZipper.UnZipAllFiles;
|
||||
|
||||
Function IsMatch(I : TFullZipFileEntry) : Boolean;
|
||||
|
||||
begin
|
||||
if UseUTF8 then
|
||||
Result:=(FFiles.IndexOf(I.UTF8ArchiveFileName)<>-1)
|
||||
else
|
||||
Result:=(FFiles.IndexOf(I.ArchiveFileName)<>-1)
|
||||
end;
|
||||
|
||||
Var
|
||||
Item : TFullZipFileEntry;
|
||||
@ -2649,18 +2727,25 @@ Var
|
||||
AllFiles : Boolean;
|
||||
|
||||
Begin
|
||||
FTerminated:=False;
|
||||
FUnZipping:=True;
|
||||
Try
|
||||
AllFiles:=(FFiles.Count=0);
|
||||
OpenInput;
|
||||
Try
|
||||
ReadZipDirectory;
|
||||
for i:=0 to FEntries.Count-1 do
|
||||
FTotPos := 0;
|
||||
FTotSize := CalcTotalSize(AllFiles);
|
||||
i:=0;
|
||||
While (I<FEntries.Count) and not Terminated do
|
||||
begin
|
||||
Item:=FEntries[i];
|
||||
if AllFiles or IsMatch(Item) then
|
||||
UnZipOneFile(Item);
|
||||
inc(I);
|
||||
end;
|
||||
if Assigned(FOnProgressEx) and not Terminated then
|
||||
FOnProgressEx(Self, FTotPos, FTotSize);
|
||||
Finally
|
||||
CloseInput;
|
||||
end;
|
||||
@ -2784,6 +2869,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TUnZipper.Terminate;
|
||||
begin
|
||||
FTerminated:=True;
|
||||
if Assigned(FCurrentDecompressor) then
|
||||
FCurrentDecompressor.Terminate;
|
||||
end;
|
||||
|
||||
destructor TUnZipper.Destroy;
|
||||
|
||||
begin
|
||||
|
||||
Loading…
Reference in New Issue
Block a user