Module ZipEx

[ts-soft]

Based on my old source here: http://www.purebasic.fr/english/viewtop ... 60#p400660
a new version as Module.

Code: Select all

;======================================================================
; Module:          ZipEx.pbi
;
; Author:          Thomas (ts-soft) Schulz
; Date:            Sep 13, 2014
; Version:         0.9
; Target Compiler: PureBasic 5.2+
; Target OS:       All
; License:         Free, unrestricted, no warranty whatsoever
;                  Use at your own risk
;======================================================================

DeclareModule ZipEx
  #ZIP_FL_NOCASE = 1
  #ZIP_FL_NODIR =	2
  #ZIP_FL_UNCHANGED = 8
  
  Declare.i AddEmptyDir(ID, dir.s)                  ; add a empty directory to archiv
  Declare.i CountEntries(ID, flags = 0)             ; returns the number of files in the zip archive, or -1 if archive is NULL
  Declare.i DeleteEntry(ID, index.q)
  Declare.i GetIndex(ID, FileName.s, flags = 0)     ; Found index by Name
  Declare.s GetArchivComment(ID, flags = 0)         ; reads the archiv comment
  Declare.s GetFileComment(ID, index.q, flags = 0)  ; reads the file comment
  Declare.i SetArchivComment(ID, comment.s)         ; add a comment to archiv
  Declare.i SetFileComment(ID, index.q, comment.s)  ; add a comment to file
  Declare.i SetDefaultPassword(ID, password.s)      ; works only for unpacking!
  Declare.i AddUnpackedFile(ID, FileName.s, PackedFilename.s) ; add a file without compression!
  Declare.s GetName(ID, index.q, flags = 0)
  Declare.i RenameEntry(ID, index.q, newname.s, flags = 0)
  
EndDeclareModule

Module ZipEx
  EnableExplicit
  UseZipPacker()
  
  #ZIP_CM_DEFAULT   = -1
  #ZIP_CM_STORE     = 0
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Import ""
      PB_Object_IsObject(object, id)
      PB_Packer_Objects
    EndImport
  CompilerElse
    ImportC ""
      PB_Object_IsObject(object, id)
      PB_Packer_Objects
    CompilerEndIf
    
    ImportC ""
      zip_add_dir(hZip.i, dir.p-utf8)
      zip_get_num_entries(hZip.i, flags.l = 0)
      zip_get_archive_comment(hZip.i, *lenp, flags.l = 0)
      zip_set_archive_comment(hZip.i, comment.p-utf8, length.l)
      zip_get_file_comment(hZip.i, index.q, *lenp, flags.l = 0)
      zip_set_file_comment(hZip.i, index.q, comment.p-utf8, length.l)
      zip_name_locate(hZip.i, fname.p-utf8, flags.l = 0)
      zip_set_default_password(hZip.i, password.p-utf8)
      zip_set_file_compression(hZip.i, index.q, comp.l, comp_flags.l = 0)
      zip_get_name(hZip.i, index.q, flags = 0)
      zip_file_rename(hZip.i, index.q, name.p-utf8, flags = 0)
      zip_delete(hZip.i, index.q)
    EndImport
    
    Procedure PackerID(id)
      Protected obj, hZip
      obj = PB_Object_IsObject(PB_Packer_Objects, id) 
      If obj
        hZip = PeekI(PeekI(obj + SizeOf(Integer)))
      EndIf
      ProcedureReturn hZip 
    EndProcedure
    
    Procedure AddEmptyDir(ID, name.s)
      If name <> ""
        ReplaceString(name, "\", "/", #PB_String_InPlace)
        If Right(name, 1) <> "/" : name + "/" : EndIf
        ProcedureReturn AddPackMemory(ID, 0, 0, name)
      EndIf
    EndProcedure
    
    Procedure AddUnpackedFile(ID, FileName.s, PackedFilename.s)
      Protected hZip = PackerID(ID), index.q
      If AddPackFile(ID, FileName, PackedFilename)
        index = GetIndex(ID, PackedFilename)
        If index > -1
          zip_set_file_compression(hZip, index, #ZIP_CM_STORE)
        EndIf
      EndIf
    EndProcedure
    
    Procedure CountEntries(ID, flags = 0) ; returns the number of files in the zip archive, or -1 if archive is NULL
      Protected hZip = PackerID(ID)
      ; Supported Flags:
      ;   #ZIP_FL_UNCHANGED = use original data, ignoring changes
      ProcedureReturn zip_get_num_entries(hZip, flags)
    EndProcedure
    
    Procedure DeleteEntry(ID, index.q)
      Protected hZip = PackerID(ID)
      
      If index < -1 : ProcedureReturn 0 : EndIf
      If index > (CountEntries(ID) -1) : ProcedureReturn 0 : EndIf
      
      If zip_delete(hZip, index) = 0
        ProcedureReturn #True
      EndIf      
    EndProcedure
    
    Procedure GetIndex(ID, FileName.s, flags = 0) ; Found index by Name
      Protected hZip = PackerID(ID)
      ; Directories are denoted by a trailing slash
      ; Supported Flags:
      ;   #ZIP_FL_NOCASE = case insensitive search
      ;   #ZIP_FL_NODIR  = ignore the path
      
      ;   Result = -1 is an error!
      ProcedureReturn zip_name_locate(hZip, FileName, flags)
    EndProcedure
    
    Procedure.s GetName(ID, index.q, flags = 0)
      Protected hZip = PackerID(ID)
      
      If index < -1 : ProcedureReturn "" : EndIf
      If index > (CountEntries(ID) -1) : ProcedureReturn "" : EndIf
      ProcedureReturn PeekS(zip_get_name(hZip, index, flags))
    EndProcedure
    
    Procedure.s  GetArchivComment(ID, flags = 0) ; reads the archiv comment
      Protected hZip = PackerID(ID)
      ; Supported Flags:
      ;   #ZIP_FL_UNCHANGED = use original data, ignoring changes
      Protected length.l, result.i
      result = zip_get_archive_comment(hZip, @length, flags)
      If result And length > 0
        ProcedureReturn PeekS(result, length, #PB_UTF8)
      EndIf
    EndProcedure
    
    Procedure.s  GetFileComment(ID, index.q, flags = 0) ; reads the file comment
      Protected hZip = PackerID(ID)
      ; Supported Flags:
      ;   #ZIP_FL_UNCHANGED = use original data, ignoring changes
      Protected length.l, result.i
      If index < -1 : ProcedureReturn "" : EndIf
      If index > (CountEntries(ID) -1) : ProcedureReturn "" : EndIf
      result = zip_get_file_comment(hZip, index, @length, flags)
      If result And length > 0
        ProcedureReturn PeekS(result, length, #PB_UTF8)
      EndIf
    EndProcedure
    
    Procedure RenameEntry(ID, index.q, newname.s, flags = 0)
      Protected hZip = PackerID(ID)
      
      If index < -1 : ProcedureReturn 0 : EndIf
      If index > (CountEntries(ID) -1) : ProcedureReturn 0 : EndIf
      If zip_file_rename(hZip, index, newname, flags) = 0
        ProcedureReturn #True
      EndIf
    EndProcedure
    
    Procedure SetArchivComment(ID, comment.s) ; add a comment to archiv
      Protected hZip = PackerID(ID)
      If zip_set_archive_comment(hZip, comment, Len(comment)) = 0
        ProcedureReturn #True
      EndIf
    EndProcedure
    
    Procedure SetFileComment(ID, index.q, comment.s) ; add a comment to file
      Protected hZip = PackerID(ID)
      If index < -1 : ProcedureReturn 0 : EndIf
      If index > (CountEntries(ID) -1) : ProcedureReturn 0 : EndIf
      If zip_set_file_comment(hZip, index, comment, Len(comment)) = 0
        ProcedureReturn #True
      EndIf
    EndProcedure
    
    Procedure SetDefaultPassword(ID, password.s) ; works only for unpacking!
      Protected hZip = PackerID(ID)
      If zip_set_default_password(hZip, password) = 0
        ProcedureReturn #True
      EndIf
    EndProcedure
    
  EndModule
  
  CompilerIf #PB_Compiler_IsMainFile
    EnableExplicit
    
    UseZipPacker()
    UseModule ZipEx
    
    Define.s Text = "Feel the _PURE_ Power!"
    
    If CreatePack(0, GetTemporaryDirectory() + "test.zip")
      AddEmptyDir(0, "Test")
      AddPackMemory(0, @Text, StringByteLength(Text), "/mem/text.txt")
      CompilerSelect #PB_Compiler_OS
        CompilerCase #PB_OS_Linux
          AddUnpackedFile(0, #PB_Compiler_Home + "sdk/compilerinterface.txt", "compilerinterface.txt")
        CompilerCase #PB_OS_Windows
          AddUnpackedFile(0, #PB_Compiler_Home + "SDK\CompilerInterface.txt", "CompilerInterface.txt")
      CompilerEndSelect
      Debug CountEntries(0)
      ClosePack(0)
    EndIf
  CompilerEndIf

[rsts]

Very nice.

Thanks for sharing

[Thorsten1867]

It seems to be dangerous to use ZipPacker in PB 5.21.
Try this!

Code: Select all

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
  
  UseZipPacker()
  
  Procedure File2Pack(File.s)
    Protected Length.i, *MemoryID
    If ReadFile(1, File)
      Length = Lof(1)
      *MemoryID = AllocateMemory(Length)
      If *MemoryID
        If ReadData(1, *MemoryID, Length)
          AddPackMemory(0, *MemoryID, MemorySize(*MemoryID), GetFilePart(File))
        EndIf
        FreeMemory(*MemoryID)
      EndIf
      CloseFile(1)
    EndIf
  EndProcedure
  
  UseModule ZipEx
  
  Define.s Text = "Das ist eine Testdatei zum Packen."
  
  If CreatePack(0, GetTemporaryDirectory() + "test.zip")
    File2Pack(#PB_Compiler_Home + "SDK\Readme.txt")
    ClosePack(0)
  EndIf
CompilerEndIf

[ts-soft]

@Thorsten1867
this problem can you found in the bugforum, for example from ABBKLAUS.

The other problem, my code doesn't work with x86

[ts-soft]

Update:
Version 0.7 works on windows x86 and x64, linux x64

[Thunder93]

Update works good for both versions of Windows. Funny thing though, different archive viewers shows different results.

PeaZip & Windows Explorer doesn't show three things, the packed memory is invisible when viewing.
7-Zip viewer does show but with an addition. There are two parent folders, one is named 'Test' the other has no name. Inside this folder with no name, it then shows a 'mem' folder and everything that follows.

Just wondering which is normal, if any?

Just thought of something before finishing this post... Updating the fourth parameter of AddPackMemory() and remove the 1st slash and tested. 7-Zip viewer now shows the mem folder as parent folder.
... Windows Explorer now sees a third thing, the mem folder and it's contents. PeaZip still doesn't see the mem folder and its contents.

[ts-soft]

Total Commander shows all as it should. A mem directory with a textfile, a empty Test dir.
On linux is the empty Dir not visible, but exists.

I think, the header written from libzip is not correct at all, but it works
I hope some problems will be solved with the next version of libzip and we become
a function like PackerID(ID) from fred

[Thunder93]

It could be as you said.. With the minor tweak that I mentioned, now it is only PeaZip not showing. And you said Total Commander also shows, I'm thinking PeaZip might have a situation. I anyways sent off an email to PeaZip technical department, might able to get better insight on this to share.

In any case... Thank you for sharing

[ts-soft]

With the minor tweak that I mentioned, now it is only PeaZip not showing.

I have changed the example, but this is a bug in PB! This line uses the pb-packerlib without API.

[Thunder93]

Received word back on it. Basically the use of PB AddPackMemory() does not actually create entries for directories in the archive table of content; in this case, there is not actually a "mem" folder inside the archive (it is been not declared).

Archive browser needs to switch to flat mode for listing some out of standard archives - https://sourceforge.net/p/peazip/tickets/3/

[Thorsten1867]

I'm missing "ZIP_IsPasswordRequired()" and "ZIP_IsZipArchive()" from MiniZip. Is it possible to add it?

[ts-soft]

This is a complete other lib (libzip) with other functions.
In the moment i can't found a function like IsPasswordRequired,
so i can't add it.

[ts-soft]

Update:
Now it should full crossplattform

+ DeleteEntry() added