Below:
unit AllZip;
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF FPC}
interface
uses
SysUtils, Classes, {$IFDEF FPC}Zipper{$ELSE}ZipForge{$ENDIF};
type
{*------------------------------------------------------------------------------
Object used to compress/decompress files
-------------------------------------------------------------------------------}
TAllZip = class( TObject )
private
{$IFDEF FPC}
TheZipper : TZipper;
TheUnZipper : TUnZipper;
{$ELSE}
TheZip : TZipForge;
{$ENDIF}
function Open : Boolean;
function GetExtractDir : String;
procedure SetExtractDir( Value : String );
function GetZipName : String;
procedure SetZipName( Value : String );
{$IFNDEF FPC}
procedure OnProcessFileFailure(Sender: TObject;FileName: String;Operation: TZFProcessOperation;
NativeError: Integer;ErrorCode: Integer;ErrorMessage: String;
var Action: TZFAction);
{$ENDIF}
public
constructor Create(AOwner : TComponent);
destructor Destroy; override;
procedure ReadArchiveList( slList : TStringList );
procedure Add( slList : TStringList );
procedure Extract();
procedure ExtractSpecificFiles( slFiles : tStringList );
procedure AddFilesBySpec( FileSpec : String );
function UncompressedAchiveSize : Int64;
property ZipFileName: String read GetZipName write SetZipName; /// Zip File Name
property ExtractDir : String read GetExtractDir write SetExtractDir; /// Folder to Extract Directory
end;
implementation
{*------------------------------------------------------------------------------
constructor of TAllZip
@param AOwner component owner
-------------------------------------------------------------------------------}
constructor TAllZip.Create(AOwner: TComponent);
begin
inherited Create;
{$IFDEF FPC}
TheZipper := TZipper.Create;
TheUnZipper := TUnZipper.Create;
{$ELSE}
TheZip := TZipForge.Create(AOwner);
TheZip.OpenCorruptedArchives := TRUE;
TheZip.Options.CreateDirs := FALSE;
TheZip.Options.StorePath := spNoPath;
TheZip.Options.OverwriteMode := omAlways;
TheZip.OnProcessFileFailure := OnProcessFileFailure;
TheZip.SpanningOptions.VolumeSize := vs600MB;
TheZip.Zip64Mode := zmAuto;
{$ENDIF}
end;
{*------------------------------------------------------------------------------
destructor of TAllZip
-------------------------------------------------------------------------------}
destructor TAllZip.Destroy;
begin
{$IFDEF FPC}
FreeAndNil(TheZipper);
FreeAndNil(TheUnZipper);
{$ELSE}
FreeAndNil(TheZip);
{$ENDIF}
inherited Destroy;
end;
{*------------------------------------------------------------------------------
procedure to add files to an archive using a wildcard specification
@param FileSpec Wild card spec
-------------------------------------------------------------------------------}
procedure TAllZip.AddFilesBySpec(FileSpec: String);
var
i : Smallint;
{$IFDEF FPC}
ZEntries : TZipFileEntries;
ThePath : String;
MySRec : TSearchRec;
{$ENDIF}
begin
{$IFDEF FPC}
ThePath := ExtractFilePAth(FileSpec);
i := SysUtils.FindFirst(FileSpec,faAnyFile,MySRec);
ZEntries := TZipFileEntries.Create(TZipFileEntry);
while( i = 0 )do
begin
ZEntries.AddFileEntry(ThePath + MySRec.name,MySRec.Name);
i := SysUtils.FindNext(MySRec);
end;
SysUtils.FindClose(MySRec);
if( ZEntries.Count > 0 )then
TheZipper.ZipFiles(ZEntries);
FreeAndNil(ZEntries);
{$ELSE}
TheZip.OpenArchive;
TheZip.AddFiles(FileSpec,faAnyFile);
TheZip.CloseArchive;
{$ENDIF}
end;
{*------------------------------------------------------------------------------
procedure to add files to an archive using FSpecArgs strings property
-------------------------------------------------------------------------------}
procedure TAllZip.Add( slList : TStringList );
var
i : Smallint;
{$IFDEF FPC}
ZEntries : TZipFileEntries;
{$ENDIF}
begin
{$IFDEF FPC}
ZEntries := TZipFileEntries.Create(TZipFileEntry);
for i := 0 to slList.Count-1 do
ZEntries.AddFileEntry(slList,ExtractFileName(slList));
TheZipper.ZipFiles(ZEntries);
FreeAndNil(ZEntries);
{$ELSE}
TheZip.OpenArchive;
for i := 0 to slList.Count - 1 do
TheZip.AddFiles(slList,faAnyFile);
TheZip.CloseArchive;
{$ENDIF}
end;
{*------------------------------------------------------------------------------
procedure to extract files using new and old passwords
-------------------------------------------------------------------------------}
procedure TAllZip.Extract();
begin
if( not Open )then
exit;
{$IFDEF FPC}
TheUnZipper.UnZipAllFiles;
{$ELSE}
TheZip.ExtractFiles('*.*');
TheZip.CloseArchive;
{$ENDIF}
end;
procedure TAllZip.ExtractSpecificFiles(slFiles: tStringList);
var
i : Integer;
begin
if( not Open )then
exit;
{$IFDEF FPC}
TheUnZipper.UnZipFiles(slFiles);
{$ELSE}
for i := 0 to slFiles.Count-1 do
TheZip.ExtractFiles(slFiles);
TheZip.CloseArchive;
{$ENDIF}
end;
{*------------------------------------------------------------------------------
function to get Extracting Directory
@return Extracting directory
-------------------------------------------------------------------------------}
function TAllZip.GetExtractDir: String;
begin
{$IFDEF FPC}
Result := TheUnzipper.OutputPath;
{$ELSE}
Result := TheZip.BaseDir;
{$ENDIF}
end;
{*------------------------------------------------------------------------------
function to get Zip File Name
@return Zip File Name
-------------------------------------------------------------------------------}
function TAllZip.GetZipName: String;
begin
{$IFDEF FPC}
Result := TheZipper.FileName;
{$ELSE}
Result := TheZip.FileName;
{$ENDIF}
end;
{*------------------------------------------------------------------------------
set Extracting Directory
@param value Extracting directory
-------------------------------------------------------------------------------}
procedure TAllZip.SetExtractDir(Value: String);
begin
{$IFDEF FPC}
TheUnzipper.OutputPath := Value;
{$ELSE}
TheZip.BaseDir := Value;
{$ENDIF}
end;
{*------------------------------------------------------------------------------
set Zip File Name
@param value Zip File Name
-------------------------------------------------------------------------------}
procedure TAllZip.SetZipName(Value: String);
begin
{$IFDEF FPC}
TheZipper.FileName := Value;
TheUnZipper.FileName := Value;
{$ELSE}
TheZip.FileName := Value;
{$ENDIF}
end;
{*------------------------------------------------------------------------------
failure event
@param Sender calling object
@param FileName File which failed
@param Operation Operation zip was doing
@param NativeError Native Error
@param ErrorCode Error Code
@param ErrorMessage Error Message
@param Action Action to do
-------------------------------------------------------------------------------}
{$IFNDEF FPC}
procedure TAllZip.OnProcessFileFailure(Sender: TObject;FileName: String;Operation: TZFProcessOperation;
NativeError: Integer;ErrorCode: Integer;ErrorMessage: String;
var Action: TZFAction);
begin
// logErrorMessage(ZipFileName + ' ' + ErrorMessage);
end;
{$ENDIF}
function TAllZip.Open: Boolean;
begin
Result := FALSE;
try
{$IFDEF FPC}
TheUnZipper.Examine;
{$ELSE}
TheZip.OpenArchive;
{$ENDIF}
Result := TRUE;
except
on E:Exception do
// logErrorMessage( ZipFileName + ' ' + E.Message);
end;
end;
{*------------------------------------------------------------------------------
function to get size of Archive
@return Uncompressed Archive Size
-------------------------------------------------------------------------------}
function TAllZip.UncompressedAchiveSize: Int64;
var
{$IFDEF FPC}
ArchiveItem: TFullZipFileEntry;
i : Integer;
{$ELSE}
ArchiveItem: TZFArchiveItem;
{$ENDIF}
begin
Result := 0;
if( not Open )then
exit;
{$IFDEF FPC}
for i := 0 to TheUnzipper.Entries.Count-1 do
begin
ArchiveItem := TheUnZipper.Entries;
Result := Result + ArchiveItem.Size;
end;
{$ELSE}
if( TheZip.FindFirst('*.*',ArchiveItem,faAnyFile-faDirectory))then
repeat
Result := Result + ArchiveItem.UncompressedSize;
until (not TheZip.FindNext(ArchiveItem));
TheZip.CloseArchive;
{$ENDIF}
end;
procedure TAllZip.ReadArchiveList(slList: TStringList);
var
{$IFDEF FPC}
ArchiveItem: TFullZipFileEntry;
i : Integer;
{$ELSE}
ArchiveItem: TZFArchiveItem;
{$ENDIF}
begin
slList.Clear;
if( not Open )then
exit;
{$IFDEF FPC}
for i := 0 to TheUnzipper.Entries.Count-1 do
begin
ArchiveItem := TheUnZipper.Entries;
slList.Add(ArchiveItem.ArchiveFileName);
end;
{$ELSE}
if( TheZip.FindFirst('*.*',ArchiveItem,faAnyFile-faDirectory))then
repeat
slList.Add(ArchiveItem.FileName);
until (not TheZip.FindNext(ArchiveItem));
TheZip.CloseArchive;
{$ENDIF}
end;
end.