* * *

Author Topic: Zip component that works for both FPC and Delphi 7?  (Read 15701 times)

touchring

  • Full Member
  • ***
  • Posts: 174
Zip component that works for both FPC and Delphi 7?
« on: April 28, 2011, 08:47:12 pm »
Hi, I've been looking for a zip component that works for both FPC and Delphi - as i've not completed porting and work is still in progress for the Delphi version. 

Had checked out http://wiki.lazarus.freepascal.org/Components_and_Code_examples#Archiving but only Abbrevia seems possible.  However, i'm not able to get a test to work - the zip created is empty.

Would appreciate any suggestions.  :)

vvzh

  • Jr. Member
  • **
  • Posts: 58
Re: Zip component that works for both FPC and Delphi 7?
« Reply #1 on: April 29, 2011, 08:58:41 am »
zip component that works for both FPC and Delphi - as i've not completed porting and work is still in progress for the Delphi version.
In that case I would use some external zip utility via command line interface. On FPC side you can use TProcess to execute external programs, on Delphi side it will probably be some WinAPI call like CreateProcess.

Once porting is complete and you don't need Delphi anymore, you can look at TZipper/TUnzipper classes in FPC FCL.

touchring

  • Full Member
  • ***
  • Posts: 174
Re: Zip component that works for both FPC and Delphi 7?
« Reply #2 on: April 29, 2011, 11:34:03 am »
zip component that works for both FPC and Delphi - as i've not completed porting and work is still in progress for the Delphi version.
In that case I would use some external zip utility via command line interface. On FPC side you can use TProcess to execute external programs, on Delphi side it will probably be some WinAPI call like CreateProcess.

Once porting is complete and you don't need Delphi anymore, you can look at TZipper/TUnzipper classes in FPC FCL.


Thanks, yes, I read about Tzipper - but there's no equivalent in Delphi.

I've managed to get fparchive-3.05 to work.  Looks ok, no memory leaks, at least for AbZipper.  For Delphi, i tested with Abbrevia 4.0.   :D

Lazarus

Quote
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  AbZipper;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
 var Zip:TAbZipper;
     sAppPath:string;
begin
  try
  try
  sAppPath := ExtractFilePath(ParamStr(0));
  Zip:=TAbZipper.Create(nil);
  Zip.BaseDirectory := sAppPath+'/archive';
 // zip.StoreOptions := [soRecurse];
  Zip.FileName := sAppPath+'/test.zip';
  Zip.AddFiles('*.*',faAnyFile);
  zip.Save;
   except
          on E: Exception do
              showmessage('Error: '+ E.Message);
    end;

  finally
    zip.Free;
  end;
end;
end.


Delphi

Quote
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, AbZipper, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var Zip:TAbZipper;
     sAppPath:string;
begin
    try
  try
  sAppPath := ExtractFilePath(ParamStr(0));
  Zip:=TAbZipper.Create(nil);
  Zip.BaseDirectory := sAppPath+'/archive';
 // zip.StoreOptions := [soRecurse];
  Zip.FileName := sAppPath+'/test.zip';
  Zip.AddFiles('*.*',faAnyFile);
  zip.Save;
   except
          on E: Exception do
              showmessage('Error: '+ E.Message);
    end;

  finally
    zip.Free;
  end;
end;
end.

Robert Gilland

  • Jr. Member
  • **
  • Posts: 81
Re: Zip component that works for both FPC and Delphi 7?
« Reply #3 on: June 08, 2011, 09:07:32 am »
I use an object which works in both FPC and Delphi.
The object uses TZipForge if compiled in Delphi and TZipper/TUnZipper if compiled in Lazarus.
Works for me.

JD

  • Hero Member
  • *****
  • Posts: 1730
Re: Zip component that works for both FPC and Delphi 7?
« Reply #4 on: June 08, 2011, 11:56:35 am »
I use an object which works in both FPC and Delphi.
The object uses TZipForge if compiled in Delphi and TZipper/TUnZipper if compiled in Lazarus.
Works for me.

If I may ask, what is the name of this object?
Windows (10, 7) - Lazarus 1.8/FPC 3.0.4, NewPascal, Delphi
Linux Mint Cinnamon  - Lazarus 1.8/FPC 3.0.4, NewPascal

Indy 10.6 series; mORMot; Zeos 7.2.1; SQLite, Firebird, PostgreSQL & MariaDB; VirtualTreeView 5.5.3 R1

Robert Gilland

  • Jr. Member
  • **
  • Posts: 81
Re: Zip component that works for both FPC and Delphi 7?
« Reply #5 on: June 09, 2011, 02:11:06 am »
Just to clarify.
I meant.

I wrote an object that uses TZipForge in Delphi and TZipper/TUnZipper in Lazarus.
I could of written it as a component. But didn't.

touchring

  • Full Member
  • ***
  • Posts: 174
Re: Zip component that works for both FPC and Delphi 7?
« Reply #6 on: June 09, 2011, 05:28:16 am »
Just to clarify.
I meant.

I wrote an object that uses TZipForge in Delphi and TZipper/TUnZipper in Lazarus.
I could of written it as a component. But didn't.

Nice, do you have sample code? 

Robert Gilland

  • Jr. Member
  • **
  • Posts: 81
Re: Zip component that works for both FPC and Delphi 7?
« Reply #7 on: June 09, 2011, 05:49:57 am »
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.

touchring

  • Full Member
  • ***
  • Posts: 174
Re: Zip component that works for both FPC and Delphi 7?
« Reply #8 on: June 09, 2011, 10:13:51 am »
Thanks Robert.  This serves as a good example of how to create code that work on both Delphi and Lazarus using non-cross platform components.

 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus