PureBasic Forums - English

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

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