[Module] ZipPlusModule.pbi

Share your advanced PureBasic knowledge/code with the community.
User avatar
Thorsten1867
Addict
Addict
Posts: 1366
Joined: Wed Aug 24, 2005 4:02 pm
Location: Germany

[Module] ZipPlusModule.pbi

Post by Thorsten1867 »

Extended Packer Library

- Adding files/storage buffers to an existing archive (otherwise: only with CreatePack)
- Replace an existing file in the archive (otherwise: duplicate)
- Delete files from the archive
- Reading archive information into the map ZIP::Info() with file names as key
- Use of further PackerPlugins (ZIP by default) possible
- File container to store compressed files or documents of a program.
- Password support for archives and file containers through file encryption

Code: Select all

;/ ============================================
;/ ||  ZipPlusModule.pbi  [PureBasic V5.6x]  ||
;/ ============================================
;/
;/ Add/replace files in existing archive or remove files from archive
;/
;/ (c) Oct. 2017 by Thorsten1867
;/

; ===== Module - Commands ======
; ZIP::UseArchive()              - Activate other packers for archive (e.g. #PB_PackerPlugin_LZMA)
; ZIP::SetPassword()             - Set password to encrypt the files in the archive
; ZIP::GetArchiveContent()       - Reading data from the files in the archive => ZIP::Info()
; ZIP::CreateArchive()           - Create archive (ggf. mit Kompressionsrate 0-9)
; ZIP::OpenArchive()             - Open archive
; ZIP::AddArchiveFile()          - Add file to archive (-> replace file, if it is already in the archive)
; ZIP::AddArchiveMemory()        - Add file from memory buffer to archive (-> Replace file if it is already in the archive)
; ZIP::UncompressArchiveFile()   - Unpack file from archive
; ZIP::UncompressArchiveMemory() - Unpack the file from the archive to the storage buffer
; ZIP::RemoveArchiveFile()       - Remove file from archive
; ZIP::ApplyChanges()            - Apply changes to the existing archive, otherwise only apply if CloseArchiv().
; ZIP::GetLastErrorMessage()     - Determine last error message
; ZIP::CloseArchive()            - Close archive
; ------------------------------
; ZIP::CheckPassword()           - Verify password and write it to the internal MAP for decryption of files
; ZIP::CheckContainerInfo()      - Read the information of a closed container in advance. (e.g. check type)
; ZIP::CheckContainerFiles()     - Read file information of a closed container in advance. (Name / Size / Date)
; ZIP::GetContentInfo()          - Reading the file information of a container using PackID. (Name / Size / Date)
; ZIP::GetFileInfo()             - Reading information about the container file by means of file name (#FileSize / #Modified)
; ZIP::SetContainerInfo()        - Set info for file container (type / description / author)
; ZIP::GetContainerInfo()        - Get information for file container (type / description / author)
; ZIP::CreateContainer()         - Create file container
; ZIP::OpenContainer()           - Open file container
; ZIP::AddContainerFile()        - Move file to the container
; ZIP::GetContainerFile()        - Get file for use from container (=unpack)
; ZIP::RemoveContainerFile()     - Deleting a file from the container
; ZIP::CloseContainer()          - Close file container & move all unzipped files back to the container
; ==============================

DeclareModule ZIP
  
  #ZipPlus_Container = #True ; Unterstützung für Datei-Container aktivieren/deaktivieren
  
  CompilerIf #ZipPlus_Container
    
    Enumeration
      #Type        = 1
      #Description = 1<<1
      #Author      = 1<<2
      #Path        = 1<<3
      #FileSize    = 1<<4
      #Modified    = 1<<5
    EndEnumeration
    
    Structure ZipFCFileStructure
      Name.s
      Size.i
      Modified.i
    EndStructure
    NewMap ZipFCFiles.ZipFCFileStructure()
    
    NewMap ZipFCInfo.s()

  CompilerEndIf
  
  ;{ ----- Structure -----
  Structure InfoStructure
    Name.s         ; Dateiname im Archiv
    File.s         ; Datei zum Hinzufügen mit Pfad
    Type.l         ; #PB_Packer_Directory / #PB_Packer_File
    Compressed.i   ; komprimierte Dateigröße
    Uncompressed.i ; Dateigröße
  EndStructure
  NewMap Info.InfoStructure()
  ;} ----------------------  
  
  ;{ ----- Basis - Befehle -----
  Declare   UseArchive(Plugin.l)
  Declare.i GetArchiveContent(ArchiveFile$, Map Entry.InfoStructure(), Plugin=#PB_PackerPlugin_Zip)
  Declare.i SetPassword(PackID.i, Password$)
  Declare.i CreateArchive(PackID.i, ArchiveFile$, Plugin.l=#PB_PackerPlugin_Zip, Level.l=#PB_Ignore)
  Declare.i OpenArchive(PackID.i, ArchiveFile$, Plugin.l=#PB_PackerPlugin_Zip)
  Declare.i AddArchiveFile(PackID.i, File$, FileName$="", Flag.i=#False)
  Declare.i AddArchiveMemory(PackID.i, *Buffer, Size.i, FileName$) 
  Declare.i UncompressArchiveFile(PackID.i, File$, FileName$="", Flag.i=#False)
  Declare.i UncompressArchiveMemory(PackID.i, *Buffer, Size.i, FileName$)
  Declare.i RemoveArchiveFile(PackID.i, FileName$)
  Declare.i ApplyChanges(PackID.i)
  Declare.s GetLastErrorMessage(PackID.i, Language.s = "")
  Declare   CloseArchive(PackID.i)
  ;} ---------------------------
  
  ; ----- Befehle für Datei-Container -----
  CompilerIf #ZipPlus_Container
    Declare.i CheckPassword(PackID.i, Password$)
    Declare.i CheckContainerInfo(ArchiveFile$, Map ZipFCInfo.s(), Plugin.l=#PB_PackerPlugin_Zip)
    Declare.i CheckContainerFiles(ArchiveFile$, Map ZipFCFiles.ZipFCFileStructure(), Plugin.l=#PB_PackerPlugin_Zip)
    Declare.i GetContentInfo(PackID.i, Map ZipFCFiles.ZipFCFileStructure())
    Declare.i GetFileInfo(PackID.i, FileName$, Flag.i)
    Declare   SetContainerInfo(PackID.i, Value$, Flag.i)
    Declare.s GetContainerInfo(PackID.i, Flag.i)
    Declare.i CreateContainer(PackID.i, ArchiveFile$, Type$="", Description$="", Author$="", Password$="", Plugin.l=#PB_PackerPlugin_Zip)
    Declare.i OpenContainer(PackID.i, ArchiveFile$, TargetPath$="", Plugin.l=#PB_PackerPlugin_Zip)
    Declare.i AddContainerFile(PackID.i, File$, FileName$="")
    Declare.i GetContainerFile(PackID.i, FileName$, Path$="")
    Declare.i RemoveContainerFile(PackID.i, FileName$)
    Declare   CloseContainer(PackID.i)
  CompilerEndIf
  ; ---------------------------------------
   
EndDeclareModule

Module ZIP
 
  UseZipPacker()
  
  EnableExplicit
  
  Procedure.s CreateUUID() ; based on code from Mistrel 
    Define Index.i, Byte.a, UUID_String.s
  
    For Index = 0 To 15
      If Index = 7
        Byte = 64 + Random(15)
      ElseIf Index = 9
        Byte = 128 + Random(63)
      Else
        Byte = Random(255)
      EndIf
      UUID_String + RSet(Hex(Byte, #PB_Ascii), 2, "0")
    Next
    
    ProcedureReturn "{"+UUID_String+"}"
  EndProcedure
  
  ;{ ----- Constants  -----
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    #Slash = "\"
  CompilerElse  
    #Slash = "/"
  CompilerEndIf
  
  Enumeration PackFlag
    #ReBuild = 1      ; Archiv muss neu erstellt und die Dateien müssen umgepackt werden
    #Create  = 1 << 1 ; neues Archiv erstellt
    #Open    = 1 << 2 ; vorhandenes Archiv geöffnet
  EndEnumeration
  
  Enumeration FileFlag
    #Archiv   = 1    ; Datei im Archive vorhanden
    #Add      = 1<<1 ; Datei zum Archiv hinzufügen
    #Replace  = 1<<2 ; Datei im Archiv ersetzen
    #Remove   = 1<<3 ; Datei aus dem Archiv entfernen
    #Move     = 1<<4 ; Datei ins Archiv verschieben (-> Datei löschen)
    #Extract  = 1<<5 ; Datei aus dem Archiv entpackt
    #Memory   = 1<<6 ; Speicherpuffer zum Archiv hinzufügen
    #AES      = 1<<7 ; Datei verschlüsseln
  EndEnumeration
  
  Enumeration Error 1
    #Error = 0
    #Error_AddPackFile
    #Error_AddPackMemory
    #Error_CreatePack
    #Error_ExaminePack
    #Error_FileExist
    #Error_MemoryBuffer
    #Error_OpenPack
    #Error_ReBuildArchive
    #Error_UncompressPackMemory
  EndEnumeration
  
  CompilerIf #ZipPlus_Container
    
    #JSON     = 0
    #ZipCFile = "ZipFContainer.json"
    #DESKey   = "ZFC1867"
    
  CompilerEndIf
  
  ;} ---------------------
  
  ;{ ----- Structures -----
  Structure PackInfoStructure
    Name.s  ; Dateiname im Archiv
    File.s  ; Datei mit Pfad
    *Memory ; Speicherpuffer mit Datei
    Size.i  ; Dateigröße    
    Type.l  ; Typ: Datei / Verzeichnis
    Flag.i  ; #Archiv / #Add / #Replace / #Remove / #Extract
  EndStructure
  
  Structure PackStructure
    ID.i       ; PackID
    Plugin.l   ; PackerPlugin
    File.s     ; Archivdatei
    Level.l    ; Kompressionsrate
    State.i    ; #Create / #Open
    Flag.i     ; #False / #Rebuild
    Error.i    ; letzter Fehler
    Password.s ; Passwort
    Map Info.PackInfoStructure()
  EndStructure
  
  CompilerIf #ZipPlus_Container
    Structure FileStructure
      Name.s
      Size.i
      Modified.i
    EndStructure
    
    Structure ZipFCStructure
      Type.s
      Description.s
      Author.s
      DES.s
      Map Files.FileStructure()
    EndStructure
    Global NewMap ZipFC.ZipFCStructure()
    
    Structure ContainerStructure
      PackID.i
      Plugin.l
      Path.s
      File.s
      AES.l
    EndStructure
    Global NewMap Container.ContainerStructure()
    
  CompilerEndIf
  ;} ----------------------
  
  ;{ ----- Variables / Maps -----
  Global TempDir$ = GetTemporaryDirectory() + CreateUUID()
  Global NewMap Pack.PackStructure()
  ;} ---------------------
  
  ;{ ----- Internal Procedures -----
  Procedure.i ReadArchiveInfo(PackID.i) ; Info zu Dateien aus Archiv auslesen (internal)
    Define FileName$, PackID$ = Str(PackID)
    
    If ExaminePack(PackID)
      ClearMap(Pack(PackID$)\Info()) 
      While NextPackEntry(PackID)
        Select PackEntryType(PackID)
          Case #PB_Packer_Directory
            FileName$ = PackEntryName(PackID)
            AddMapElement(Pack(PackID$)\Info(), FileName$)
            Pack(PackID$)\Info()\Name = FileName$
            Pack(PackID$)\Info()\Type = #PB_Packer_Directory
          Case #PB_Packer_File
            FileName$ = PackEntryName(PackID)
            AddMapElement(Pack(PackID$)\Info(), FileName$)
            Pack(PackID$)\Info()\Name = FileName$
            Pack(PackID$)\Info()\Type = #PB_Packer_File
            Pack(PackID$)\Info()\Size = PackEntrySize(PackID, #PB_Packer_UncompressedSize)
        EndSelect
      Wend
      ProcedureReturn MapSize(Pack(PackID$)\Info())    ; Anzahl der ausgelesenen Dateien
    EndIf
    
  EndProcedure
  
  
  Procedure.i EncryptFile(PackID.i, File$, FileName$="") 
    Define Result.i, FileID.i, FileSize.i
    Define Password$ = Pack(Str(PackID))\Password
    Define *FileMemory, *MemoryBuffer
    
    If FileName$ = "" : FileName$ = GetFilePart(File$) : EndIf
    If FileSize(File$) <= 0 : ProcedureReturn #False : EndIf
    
    FileID = ReadFile(#PB_Any, File$)
    If FileID
      FileSize = Lof(FileID)
        *FileMemory = AllocateMemory(FileSize)
        If *FileMemory
          If ReadData(FileID, *FileMemory, FileSize)
            *MemoryBuffer = AllocateMemory(FileSize)
            If *MemoryBuffer
              If AESEncoder(*FileMemory, *MemoryBuffer, MemorySize(*FileMemory), @Password$, 128, #False, #PB_Cipher_ECB)
                If PackID
                  Result = AddPackMemory(PackID, *MemoryBuffer, MemorySize(*FileMemory), FileName$)
                EndIf
              EndIf
              FreeMemory(*MemoryBuffer)
            EndIf
          FreeMemory(*FileMemory)
        EndIf
      EndIf
      CloseFile(FileID)
    EndIf
    
    ProcedureReturn Result
  EndProcedure  

  Procedure.i DecryptFile(PackID.i, File$, FileName$="") 
    Define FileID.i, Result.i, PackID$ = Str(PackID)
    Define FileSize.i = ZipFC(PackID$)\Files(FileName$)\Size
    Define FileName$, Password$ = Pack(PackID$)\Password
    Define *FileMemory, *MemoryBuffer
    
    If FileName$ = "" : FileName$ = GetFilePart(File$) : EndIf
    If Not FileSize : ProcedureReturn #False : EndIf
 
    If PackID
      *MemoryBuffer = AllocateMemory(FileSize)
      If *MemoryBuffer
        If UncompressPackMemory(PackID, *MemoryBuffer, FileSize, FileName$)
          *FileMemory = AllocateMemory(FileSize)
          If *FileMemory
            If AESDecoder(*MemoryBuffer, *FileMemory, MemorySize(*MemoryBuffer), @Password$, 128, #False, #PB_Cipher_ECB)
              FileID = OpenFile(#PB_Any, "D:\Temp\Test1.pdf")
              If FileID
                Result = WriteData(FileID, *FileMemory, MemorySize(*FileMemory))
                CloseFile(FileID)
              EndIf
            EndIf
            FreeMemory(*FileMemory)
          EndIf
        EndIf
        FreeMemory(*MemoryBuffer)
      EndIf
    EndIf
    
    ProcedureReturn Result
  EndProcedure
  
  
  Procedure.i ReBuildArchive(PackID.i)
    Define Flag.i, PackResult.i, TempID.i, Result.i = #False
    Define *Buffer, MemSize.i
    Define FileName$, ArchiveFile$, TempArchive$, PackID$ = Str(PackID)
    
    ArchiveFile$ = Pack(PackID$)\File
    TempArchive$ = TempDir$ + GetFilePart(ArchiveFile$)
    
    ClosePack(PackID) ; Archiv vor dem Kopieren schließen
    
    If CopyFile(ArchiveFile$, TempArchive$) ; Verschiebe Archiv in temporäres Verzeichnis
      
      DeleteFile(ArchiveFile$, #PB_FileSystem_Force) ; Archiv nur löschen, wenn Kopieren erfolgreich
      
      ;{ Rebuild -> neues Archiv erstellen
      If Pack(PackID$)\Level = #PB_Ignore
        Result = CreatePack(PackID, ArchiveFile$, Pack(PackID$)\Plugin)
        Pack()\State = #Create   ; Neues Archiv erstellt
      Else
        Result = CreatePack(PackID, ArchiveFile$, Pack(PackID$)\Plugin, Pack(PackID$)\Level)
        Pack()\State = #Create   ; Neues Archiv erstellt
      EndIf ;}
      
      ;{ Rebuild -> Vorhandene Dateien in neues Archiv übertragen bzw. hinzufügen/ersetzen
      If Result
        TempID = OpenPack(#PB_Any, TempArchive$, Pack(PackID$)\Plugin)
        If TempID
          
          ;{ Archivdatei auslesen und Dateien umpacken
          If ExaminePack(TempID) 
            
            While NextPackEntry(TempID)
              FileName$ = PackEntryName(TempID)
              Select PackEntryType(TempID)
                Case #PB_Packer_Directory ; Verzeichnisse ignorieren
                  Continue
                Case #PB_Packer_File      ; Datei im Archiv                 
                  If FindMapElement(Pack(PackID$)\Info(), FileName$) ; Datei in interner MAP vorhanden
                    Flag = Pack(PackID$)\Info()\Flag
                    If Flag & #Move                                  ;{ Datei in Archiv verschieben
                      If Flag & #AES
                        Pack(PackID$)\Info()\Flag = #Add|#Move|#AES
                      Else
                        Pack(PackID$)\Info()\Flag = #Add|#Move
                      EndIf
                      Continue ;}
                    ElseIf Flag & #Replace                           ;{ vorherige Datei ignorieren
                      If Pack(PackID$)\Info()\Flag & #Memory
                        Pack(PackID$)\Info()\Flag = #Add|#Memory
                      Else
                        If Flag & #AES
                          Pack(PackID$)\Info()\Flag = #Add|#AES
                        Else
                          Pack(PackID$)\Info()\Flag = #Add
                        EndIf
                      EndIf
                      Continue ;}
                    ElseIf Flag & #Remove                            ;{ Datei komplett entfernen
                      DeleteMapElement(Pack(PackID$)\Info())         ; Datei aus interner MAP löschen
                      Continue
                    EndIf ;}
                  Else                                               ;{ Datei fehlt in interner MAP
                    AddMapElement(Pack(PackID$)\Info(), FileName$)
                    Pack(PackID$)\Info()\Name = FileName$
                    Pack(PackID$)\Info()\Type = #PB_Packer_File
                    Pack(PackID$)\Info()\Size = PackEntrySize(TempID, #PB_Packer_UncompressedSize)
                   ;}
                  EndIf
              EndSelect
              
              ;{ Datei zum neuen Archiv hinzufügen
              MemSize = PackEntrySize(TempID, #PB_Packer_UncompressedSize)
              *Buffer = AllocateMemory(MemSize)
              If *Buffer
                PackResult = #False
                If UncompressPackMemory(TempID, *Buffer, MemSize) <> -1
                  PackResult = AddPackMemory(PackID, *Buffer, MemSize, FileName$)
                  If PackResult : Pack(PackID$)\Info(FileName$)\Flag = #Archiv : EndIf
                Else
                  Pack(PackID$)\Error = #Error_UncompressPackMemory
                EndIf
                FreeMemory(*Buffer)
              EndIf ;}
              
              If PackResult = #False : Result = #False : EndIf
              
            Wend
            
          Else
            Pack(PackID$)\Error = #Error_ExaminePack
          EndIf ;}
          
          ;{ Dateien zum Archiv hinzufügen <-- AddArchiveFile() / AddArchiveMemory()
          ForEach Pack(PackID$)\Info()
            
            If Pack(PackID$)\Info()\Flag & #Add
              PackResult = #False
              If Pack(PackID$)\Info()\Flag & #Memory ;{ Speicherpuffer zum Archiv hinzufügen
                If Pack(PackID$)\Info()\Memory
                  PackResult = AddPackMemory(PackID, Pack(PackID$)\Info()\Memory, Pack(PackID$)\Info()\Size, Pack(PackID$)\Info()\Name)
                  If PackResult
                    Pack(PackID$)\Info()\Flag = #Archiv
                  EndIf
                Else
                  Pack(PackID$)\Error = #Error_MemoryBuffer
                  Result = #False
                EndIf ;}
              Else                                   ;{ Datei zum Archiv hinzufügen
                If FileSize(Pack(PackID$)\Info()\File) > 0
                  
                  If Pack(PackID$)\Info()\Flag & #AES
                    PackResult = EncryptFile(PackID, Pack(PackID$)\Info()\File, Pack(PackID$)\Info()\Name)
                  Else
                    PackResult = AddPackFile(PackID, Pack(PackID$)\Info()\File, Pack(PackID$)\Info()\Name)
                  EndIf
                  
                  If PackResult
                    If Pack(PackID$)\Info()\Flag & #Move
                      Pack(PackID$)\Info()\Flag = #Archiv|#Move
                    Else
                      Pack(PackID$)\Info()\Flag = #Archiv
                    EndIf
                  EndIf
                  
                Else
                  Pack(PackID$)\Error = #Error_FileExist
                  Result = #False
                EndIf ;}
              EndIf
            EndIf
            
            If PackResult = #False : Result = #False : EndIf
            
          Next ;}
          
          ClosePack(TempID)
        Else
          Pack(PackID$)\Error = #Error_OpenPack
          Result = #False
        EndIf
      Else
        Pack(PackID$)\Error = #Error_CreatePack
        Result = #False
      EndIf ;}
      
      If Result = #False ;{ Bei Fehler Archiv wiederherstellen
        
        If CopyFile(TempArchive$, ArchiveFile$)
          Result = OpenPack(PackID, ArchiveFile$, Pack(PackID$)\Plugin)
          Pack()\State = #Open
        EndIf
        
        Pack(PackID$)\Error = #Error_ReBuildArchive
        ;}
      Else               ;{ ReBuild erfolgreich
        
        ForEach Pack(PackID$)\Info() ;{ Dateien mit Flag = #Move löschen
          If Pack(PackID$)\Info()\Flag & #Move
            If DeleteFile(Pack(PackID$)\Info()\File, #PB_FileSystem_Force)
              Pack(PackID$)\Info()\Flag = #Archiv
            EndIf
          EndIf
        Next ;}
        
        Pack(PackID$)\Flag  = #False ; #ReBuild zurücksetzen
        
        ;}
      EndIf
      
    EndIf
    
    ProcedureReturn Result
  EndProcedure
  ;} -------------------------------
  
  ;  ----- Declared Commands -----
  
  Procedure   UseArchive(Plugin.l)
    Select Plugin
      Case #PB_PackerPlugin_BriefLZ
        UseBriefLZPacker()
      Case #PB_PackerPlugin_Lzma
        UseLZMAPacker()
      Case #PB_PackerPlugin_Tar
        UseTARPacker()
      Case #PB_PackerPlugin_Zip
        UseZipPacker()
    EndSelect 
  EndProcedure
  
  Procedure.i GetArchiveContent(ArchiveFile$, Map Entry.InfoStructure(), Plugin=#PB_PackerPlugin_Zip) ; Daten der Dateien im Archiv auslesen
    Define PackID.i, FileName$
    PackID = OpenPack(#PB_Any, ArchiveFile$, Plugin)
    If PackID
      If ExaminePack(PackID)
        ClearMap(Entry()) 
        While NextPackEntry(PackID)
          Select PackEntryType(PackID)
            Case #PB_Packer_Directory
              FileName$ = PackEntryName(PackID)
              AddMapElement(Entry(), FileName$)
              Entry()\Name = FileName$
              Entry()\Type = #PB_Packer_Directory
            Case #PB_Packer_File
              FileName$ = PackEntryName(PackID)
              AddMapElement(Entry(), FileName$)
              Entry()\Name = FileName$
              Entry()\Type = #PB_Packer_File
              Entry()\Compressed   = PackEntrySize(PackID, #PB_Packer_CompressedSize)
              Entry()\Uncompressed = PackEntrySize(PackID, #PB_Packer_UncompressedSize)
          EndSelect
        Wend
        ProcedureReturn MapSize(Entry())    ; Anzahl der ausgelesenen Dateien
      EndIf
    EndIf
  EndProcedure
  
  Procedure.i SetPassword(PackID.i, Password$)
    Define PackID$ = Str(PackID)
    
    Pack(PackID$)\Password = Password$
    
  EndProcedure  

  
  Procedure.i CreateArchive(PackID.i, ArchiveFile$, Plugin.l=#PB_PackerPlugin_Zip, Level.l=#PB_Ignore)
    Define Result.i = #False, PackID$ = Str(PackID)
    
    ;{ Archiv erstellen mit/ohne Kompressionsrate
    If Level = #PB_Ignore
      Result = CreatePack(PackID, ArchiveFile$, Plugin)
    Else
      Result = CreatePack(PackID, ArchiveFile$, Plugin, Level)
    EndIf ;}
    
    If Result
      
      If PackID = #PB_Any
        PackID = Result
        PackID$ = Str(PackID)
      EndIf
      
      ;{ Archiv zur internen MAP hinzufügen
      AddMapElement(Pack(), PackID$)
      Pack()\ID      = PackID
      Pack()\File    = ArchiveFile$
      Pack()\Plugin  = Plugin
      Pack()\Level   = Level
      Pack()\State   = #Create   ; Neues Archiv erstellt
      Pack()\Flag    = #False    ; noch kein ReBuild nötig
      ;} ---------------------
      
      CreateDirectory(TempDir$) ; Temporäres Verzeichnis erstellen

    EndIf
    
    ProcedureReturn Result
  EndProcedure
  
  Procedure.i OpenArchive(PackID.i, ArchiveFile$, Plugin.l=#PB_PackerPlugin_Zip)
    Define Result.i = #False, PackID$ = Str(PackID), Level.l = #False

    Result = OpenPack(PackID, ArchiveFile$, Plugin) ; Vorhandenes Archiv öffnen
    
    If Result
      
      If PackID = #PB_Any
        PackID = Result
        PackID$ = Str(PackID)
      EndIf
      
      ;{ Archiv zur internen MAP hinufügen
      AddMapElement(Pack(), PackID$)
      Pack()\ID      = PackID
      Pack()\File    = ArchiveFile$
      Pack()\Plugin  = Plugin
      Pack()\Level   = #PB_Ignore
      Pack()\State   = #Open     ; Vorhandenes Archiv geöffnet
      Pack()\Flag    = #False    ; noch kein ReBuild nötig
      ;} ---------------------
      
      ReadArchiveInfo(PackID)   ; Archiv-Infos auslesen
      
      CreateDirectory(TempDir$) ; Temporäres Verzeichnis erstellen
      
    EndIf

    ProcedureReturn Result
  EndProcedure
  
  
  Procedure.i AddArchiveFile(PackID.i, File$, FileName$="", Flag.i=#False)  ; Flag: #Move / #AES
    Define Result.i = #False, PackID$ = Str(PackID)
    
    If FileName$ = "" : FileName$ = GetFilePart(File$) : EndIf
    
    Select Pack(PackID$)\State
      Case #Create ; Neues Archiv erstellt
        
        If FindMapElement(Pack(PackID$)\Info(), FileName$)
          ;{ Datei bereits im Archiv vorhanden
          Pack(PackID$)\Info()\File = File$           ; Datei mit Pfadangabe
          Pack(PackID$)\Info()\Name = FileName$       ; Dateiname im Archiv
          Pack(PackID$)\Info()\Size = FileSize(File$) ; Dateigröße (unkomprimiert)
          If Flag & #Move                             ;{ Datei wird ins Archiv verschoben
            If Flag & #AES
              ; Datei wird verschlüsselt
              Pack(PackID$)\Info()\Flag = #Move|#AES
            Else
              Pack(PackID$)\Info()\Flag = #Move         
            EndIf ;}
          Else                                        ;{ Datei wird im Archiv ersetzt
            If Flag & #AES
              Pack(PackID$)\Info()\Flag = #Replace|#AES ; Datei wird verschlüsselt
            Else
              Pack(PackID$)\Info()\Flag = #Replace      
            EndIf ;}
          EndIf
          Pack(PackID$)\Flag = #ReBuild               ; Archiv muss neu erstellt und die Dateien müssen umgepackt werden
          Result = #True
          ;} ---------------------------------
        Else
          ;{ Datei noch nicht im Archiv vorhanden
          If Flag & #AES
            Result = EncryptFile(PackID, File$, FileName$)
          Else
            Result = AddPackFile(PackID, File$, FileName$)
          EndIf
          If Result
            AddMapElement(Pack(PackID$)\Info(), FileName$)
            Pack(PackID$)\Info()\File = File$           ; Datei mit Pfadangabe
            Pack(PackID$)\Info()\Name = FileName$       ; Dateiname im Archiv
            Pack(PackID$)\Info()\Size = FileSize(File$) ; Dateigröße (unkomprimiert)
            Pack(PackID$)\Info()\Type = #PB_Packer_File ; Typ: Datei
            Pack(PackID$)\Info()\Flag = #Archiv         ; Datei befindet sich nun im Archiv
            If Flag & #Move : DeleteFile(File$) : EndIf
          EndIf ;}
        EndIf
        
        If Result = #Error : Pack(PackID$)\Error = #Error_AddPackFile : EndIf
        
        ProcedureReturn Result
        
      Case #Open   ; Vorhandenes Archiv geöffnet
        
        Pack(PackID$)\Flag = #ReBuild ; Archiv muss neu erstellt und die Dateien müssen umgepackt werden
        
        If FindMapElement(Pack(PackID$)\Info(), FileName$)
          ; Datei bereits im Archiv vorhanden
          Pack(PackID$)\Info()\File = File$           ; Datei mit Pfadangabe
          Pack(PackID$)\Info()\Name = FileName$       ; Dateiname im Archiv
          Pack(PackID$)\Info()\Size = FileSize(File$) ; Dateigröße (unkomprimiert)
          If Flag & #Move                             ;{ Datei wird ins Archiv verschoben
            ; Datei wird verschlüsselt
            If Flag & #AES
              Pack(PackID$)\Info()\Flag = #Move|#AES  
            Else
              Pack(PackID$)\Info()\Flag = #Move
            EndIf ;}
          Else                                        ;{ Datei muss vorher aus dem Archiv entfernt
            ; Datei wird verschlüsselt
            If Flag & #AES
              Pack(PackID$)\Info()\Flag = #Replace|#AES
            Else
              Pack(PackID$)\Info()\Flag = #Replace      
            EndIf ;}
          EndIf
        Else
          ; Datei noch nicht im Archiv vorhanden
          AddMapElement(Pack(PackID$)\Info(), FileName$)
          Pack(PackID$)\Info()\File = File$           ; Datei mit Pfadangabe
          Pack(PackID$)\Info()\Name = FileName$       ; Dateiname im Archiv
          Pack(PackID$)\Info()\Size = FileSize(File$) ; Dateigröße (unkomprimiert)
          Pack(PackID$)\Info()\Type = #PB_Packer_File ; Typ: Date
          If Flag & #Move                             ;{ Datei wird ins Archiv verschoben
            ; Datei wird verschlüsselt
            If Flag & #AES
              Pack(PackID$)\Info()\Flag = #Move|#AES 
            Else
              Pack(PackID$)\Info()\Flag = #Move         
            EndIf ;}
          Else                                        ;{ Datei muss vorher aus dem Archiv entfernt
            If Flag & #AES
              Pack(PackID$)\Info()\Flag = #Add|#AES
            Else  
              Pack(PackID$)\Info()\Flag = #Add      
            EndIf ;}
          EndIf
          ; ---------------------------------
        EndIf

        ProcedureReturn #True
        
    EndSelect
    
  EndProcedure
  
  Procedure.i AddArchiveMemory(PackID.i, *Buffer, Size.i, FileName$)
    Define Result.i = #False, PackID$ = Str(PackID)
    
    Select Pack(PackID$)\State
      Case #Create ; Neues Archiv erstellt
        
        ;{ Speicherpuffer komprimieren und als Datei zum  Archiv hinzufügen
        If FindMapElement(Pack(PackID$)\Info(), FileName$) ; Datei bereits im Archiv vorhanden
          ;{ Datei bereits im Archiv vorhanden
          Pack(PackID$)\Info()\File   = ""               ; Datei mit Pfadangabe
          Pack(PackID$)\Info()\Name   = FileName$        ; Dateiname im Archiv
          Pack(PackID$)\Info()\Memory = *Buffer          ; Speicherpuffer mit Datei
          Pack(PackID$)\Info()\Size   = Size             ; Größe des Speichers
          Pack(PackID$)\Info()\Flag   = #Replace|#Memory ; Datei muss vorher aus dem Archiv entfernt werden
          Pack(PackID$)\Flag          = #ReBuild         ; Archiv muss neu erstellt und die Dateien müssen umgepackt werden
          
          Result = ReBuildArchive(PackID)                ; sofortiger ReBuild des Archivs nötig
          ;} ---------------------------------
        Else
          ;{ Datei noch nicht im Archiv vorhanden
          Result = AddPackMemory(PackID, *Buffer, Size, FileName$)
          If Result
            AddMapElement(Pack(PackID$)\Info(), FileName$)
            Pack(PackID$)\Info()\File = ""
            Pack(PackID$)\Info()\Name = FileName$
            Pack(PackID$)\Info()\Size = Size
            Pack(PackID$)\Info()\Type = #PB_Packer_File
            Pack(PackID$)\Info()\Flag = #Archiv
          EndIf ;}
        EndIf  
        ;} -----------------------------------------------------------------
        
        If Result = #Error : Pack(PackID$)\Error = #Error_AddPackMemory : EndIf
        
        ProcedureReturn Result
        
      Case #Open   ; Vorhandenes Archiv geöffnet
        
        Pack(PackID$)\Flag = #ReBuild ; Archiv muss neu erstellt und die Dateien müssen umgepackt werden
        
        If FindMapElement(Pack(PackID$)\Info(), FileName$) ; Datei bereits im Archiv vorhanden
          
          ;{ Datei bereits im Archiv vorhanden
          Pack(PackID$)\Info()\File   = ""               ; Datei mit Pfadangabe
          Pack(PackID$)\Info()\Name   = FileName$        ; Dateiname im Archiv
          Pack(PackID$)\Info()\Memory = *Buffer          ; Speicherpuffer mit Datei
          Pack(PackID$)\Info()\Size   = Size             ; Größe des Speichers
          Pack(PackID$)\Info()\Flag   = #Replace|#Memory ; Datei muss vorher aus dem Archiv entfernt werden 
          ;} ---------------------------------
          
          Result = ReBuildArchive(PackID)                ; sofortiger ReBuild des Archivs nötig
          
        Else
          
          ;{ Datei noch nicht im Archiv vorhanden
          AddMapElement(Pack(PackID$)\Info(), FileName$)
          Pack(PackID$)\Info()\File   = ""              ; Datei mit Pfadangabe
          Pack(PackID$)\Info()\Name   = FileName$       ; Dateiname im Archiv
          Pack(PackID$)\Info()\Memory = *Buffer         ; Speicherpuffer mit Datei
          Pack(PackID$)\Info()\Size   = Size            ; Größe des Speichers
          Pack(PackID$)\Info()\Type   = #PB_Packer_File ; Typ: Datei
          Pack(PackID$)\Info()\Flag   = #Add|#Memory    ; Datei muss noch zum Archiv hinzugefügt werden
          ;} -----------------------------------
          
          Result = ReBuildArchive(PackID) ; sofortiger ReBuild des Archivs nötig
          
        EndIf
        
    EndSelect
    
    ProcedureReturn Result
  EndProcedure
  
  
  Procedure.i UncompressArchiveFile(PackID.i, File$, FileName$="", Flag.i=#False)  ; Flag: #AES
    Define Result.i = #False, PackID$ = Str(PackID)
    
    If FileName$ = "" : FileName$ = GetFilePart(File$) : EndIf
    
    If Flag & #AES
      Result = DecryptFile(PackID, File$, FileName$)
    Else
      Result = UncompressPackFile(PackID, File$, FileName$)
    EndIf
      
    If Result
      Pack(PackID$)\Info(FileName$)\File = File$
      Pack(PackID$)\Info(FileName$)\Flag = #Extract
    EndIf
    
    ProcedureReturn Result
  EndProcedure  
  
  Procedure.i UncompressArchiveMemory(PackID.i, *Buffer, Size.i, FileName$)
    Define Result.i = #False, PackID$ = Str(PackID)
    
    Result = UncompressPackMemory(PackID, *Buffer, Size, FileName$)
    If Result
      Pack(PackID$)\Info(FileName$)\File = ""
      Pack(PackID$)\Info(FileName$)\Flag = #Extract|#Memory
    EndIf
    
    ProcedureReturn Result
  EndProcedure
  
  
  Procedure.i RemoveArchiveFile(PackID.i, FileName$)
    Define PackID$ = Str(PackID)
    
    If FindMapElement(Pack(PackID$)\Info(), FileName$)
      Pack(PackID$)\Info()\Flag = #Remove  ; Datei soll entfernt werden
      Pack(PackID$)\Flag        = #ReBuild ; Archiv muss neu erstellt und die Dateien müssen umgepackt werden
      ProcedureReturn #True
    EndIf
    
    ProcedureReturn #False
  EndProcedure  
  
  Procedure.i ApplyChanges(PackID.i)
    Define PackID$ = Str(PackID)
    
    If Pack(PackID$)\Flag = #ReBuild
      If ReBuildArchive(PackID)
        Pack(PackID$)\Flag = #False
        ProcedureReturn #True
      EndIf
    Else 
      ProcedureReturn #True
    EndIf
    
    ProcedureReturn #False
  EndProcedure  
  
  
  Procedure.s GetLastErrorMessage(PackID.i, Language.s = "")
    Define PackID$ = Str(PackID)
    
    Select Language
      Case "DEU" ;{ Deutsch
        Select Pack(PackID$)\Error
          Case #Error_AddPackFile
            ProcedureReturn "Hinfügen der Datei zum Archiv fehlgeschlagen."
          Case #Error_AddPackMemory
            ProcedureReturn "Hinzufügen der Datei aus dem Speicherpuffer fehlgeschlagen."
          Case #Error_CreatePack
            ProcedureReturn "Archiv konnte nicht erstellt werden."
          Case #Error_ExaminePack
            ProcedureReturn "Die Archiv-Informationen konnten nicht ausgelesen werden."
          Case #Error_FileExist
            ProcedureReturn "Die hinzuzufügende Datei wurde nicht gefunden."
          Case #Error_MemoryBuffer
            ProcedureReturn "Der hinzuzufügende Speicherpuffer ist ungültig."
          Case #Error_OpenPack
            ProcedureReturn "Das Öffnen des Archives ist fehlgeschlagen."
          Case #Error_ReBuildArchive
            ProcedureReturn "Der Rebuild des Archivs ist fehlgeschlagen."
          Case #Error_UncompressPackMemory
            ProcedureReturn "Das Enpacken in den Speicher ist fehlgeschlagen."
          Default
            ProcedureReturn ""
        EndSelect ;}
      Default    ;{ English
        Select Pack(PackID$)\Error
          Case #Error_AddPackFile
            ProcedureReturn "Adding the file to the archive failed."
          Case #Error_AddPackMemory
            ProcedureReturn "Adding the file from memory buffer failed."
          Case #Error_CreatePack
            ProcedureReturn "Archive could not be created."
          Case #Error_ExaminePack
            ProcedureReturn "The archive information could not be read out."
          Case #Error_FileExist
            ProcedureReturn "The file to be added was not found."
          Case #Error_MemoryBuffer
            ProcedureReturn "The memory buffer to be added is invalid."
          Case #Error_OpenPack
            ProcedureReturn "Opening the archive failed."
          Case #Error_ReBuildArchive
            ProcedureReturn "The archive rebuild failed."
          Case #Error_UncompressPackMemory
            ProcedureReturn "The unpacking to memory failed."
          Default
            ProcedureReturn ""
        EndSelect ;}
    EndSelect
    
  EndProcedure
  
  Procedure   CloseArchive(PackID.i)
    Define PackID$ = Str(PackID)
    
    If Pack(PackID$)\Flag = #ReBuild
      ReBuildArchive(PackID)
    EndIf
    
    ClosePack(PackID)
    
    DeleteMapElement(Pack(), PackID$) ; Remove Archiv from internal MAP
    DeleteDirectory(TempDir$, "*.*", #PB_FileSystem_Force|#PB_FileSystem_Recursive)
    
  EndProcedure
  
  
  CompilerIf #ZipPlus_Container
    
    Procedure   AddFile2ZipFC(PackID.i, File$)  ; Datei-Infos zur ZipFC-MAP hinzufügen
      Define FileName$, PackID$=Str(PackID)
      
      FileName$ = GetFilePart(File$)
      If FindMapElement(ZipFC(PackID$)\Files(), FileName$)
        ZipFC(PackID$)\Files()\Size     = FileSize(File$)
        ZipFC(PackID$)\Files()\Modified = GetFileDate(File$, #PB_Date_Modified)
      Else
        AddMapElement(ZipFC(PackID$)\Files(), FileName$)
        ZipFC(PackID$)\Files()\Name     = FileName$
        ZipFC(PackID$)\Files()\Size     = FileSize(File$)
        ZipFC(PackID$)\Files()\Modified = GetFileDate(File$, #PB_Date_Modified)
      EndIf
      
    EndProcedure
    
    Procedure   SaveZipFCFile(PackID.i)
      Define File$, PackID$ = Str(PackID)
      Define Save.ZipFCStructure
      
      ;{ Kopiere Daten in Struktur
      Save\Type        = ZipFC(PackID$)\Type
      Save\Description = ZipFC(PackID$)\Description
      Save\Author      = ZipFC(PackID$)\Author
      Save\DES         = ZipFC(PackID$)\DES
      CopyMap(ZipFC(PackID$)\Files(), Save\Files())
      ;}
      
      File$ = TempDir$ + #Slash + #ZipCFile      
      
      If CreateJSON(#JSON)
        InsertJSONStructure(JSONValue(#JSON), @Save, ZipFCStructure)
        If SaveJSON(#JSON, File$) ; #PB_JSON_PrettyPrint
          AddArchiveFile(PackID, File$)
        EndIf
      EndIf
      
    EndProcedure
    
    Procedure   LoadZipFCFile(PackID.i)
      Define File$, PackID$ = Str(PackID)
      Define Load.ZipFCStructure

      File$ = TempDir$ + #Slash + #ZipCFile
      
      If UncompressPackFile(PackID, File$, GetFilePart(File$))
        If LoadJSON(#JSON, File$)
          ExtractJSONStructure(JSONValue(#JSON), @Load.ZipFCStructure, ZipFCStructure)
          Pack(PackID$)\Info(GetFilePart(File$))\File = File$
          Pack(PackID$)\Info(GetFilePart(File$))\Flag = #Extract
          ;{ Kopiere Daten in Map         
          ZipFC(PackID$)\Type        = Load\Type
          ZipFC(PackID$)\Description = Load\Description
          ZipFC(PackID$)\Author      = Load\Author
          ZipFC(PackID$)\DES         = Load\DES
          Debug "JSON: " + ZipFC(PackID$)\DES
          CopyMap(Load\Files(), ZipFC(PackID$)\Files())
          ;}
        EndIf
      EndIf
      
    EndProcedure
    
    
    Procedure.i CheckPassword(PackID.i, Password$)
      Define PackID$ = Str(PackID)
      
      If ZipFC(PackID$)\DES = DESFingerprint(Password$, #DESKey)
        Pack(PackID$)\Password = Password$
        Container(PackID$)\AES = #True
        ProcedureReturn #True
      Else
        Container(PackID$)\AES = #False
        Pack(PackID$)\Password = ""
        ProcedureReturn #False
      EndIf
      
    EndProcedure

    Procedure   SetContainerInfo(PackID.i, Value$, Flag.i)
      Define PackID$ = Str(PackID)
      
      Select Flag
        Case #Type
          ZipFC(PackID$)\Type        = Value$
        Case #Description
          ZipFC(PackID$)\Description = Value$
        Case #Author
          ZipFC(PackID$)\Author      = Value$
      EndSelect
      
    EndProcedure
    
    Procedure.s GetContainerInfo(PackID.i, Flag.i)
      Define PackID$ = Str(PackID)
      
      Select Flag
        Case #Type
          ProcedureReturn ZipFC(PackID$)\Type
        Case #Description
          ProcedureReturn ZipFC(PackID$)\Description
        Case #Author
          ProcedureReturn ZipFC(PackID$)\Author
      EndSelect
      
    EndProcedure  
    
    Procedure.i GetFileInfo(PackID.i, FileName$, Flag.i)
      Define PackID.i, PackID$=Str(PackID)
   
      Select Flag
        Case #FileSize
          ProcedureReturn ZipFC(PackID$)\Files(FileName$)\Size
        Case #Modified
          ProcedureReturn ZipFC(PackID$)\Files(FileName$)\Modified
      EndSelect
      
    EndProcedure
    
    Procedure.i GetContentInfo(PackID.i, Map ZipFCFiles.ZipFCFileStructure())
      Define PackID.i, PackID$=Str(PackID)
   
      If CopyMap(ZipFC(PackID$)\Files(), ZipFCFiles())
        ProcedureReturn #True
      EndIf
      
    EndProcedure
    
    Procedure.i CheckContainerFiles(ArchiveFile$, Map ZipFCFiles.ZipFCFileStructure(), Plugin.l=#PB_PackerPlugin_Zip)
      Define PackID.i, PackID$
      
      PackID = OpenArchive(#PB_Any, ArchiveFile$, Plugin)
      If PackID
        PackID$ = Str(PackID)
        
        AddMapElement(ZipFC(), PackID$)
        LoadZipFCFile(PackID)
        
        CopyMap(ZipFC(PackID$)\Files(), ZipFCFiles())
        
        DeleteMapElement(ZipFC(), PackID$)
        DeleteDirectory(TempDir$, "*.*", #PB_FileSystem_Force|#PB_FileSystem_Recursive)
        
        ClosePack(PackID)
        ProcedureReturn #True
      EndIf
      
    EndProcedure
    
    Procedure.i CheckContainerInfo(ArchiveFile$, Map ZipFCInfo.s(), Plugin.l=#PB_PackerPlugin_Zip)
      Define PackID.i, PackID$
      
      PackID = OpenArchive(#PB_Any, ArchiveFile$, Plugin)
      If PackID
        PackID$ = Str(PackID)
        
        AddMapElement(ZipFC(), PackID$)
        LoadZipFCFile(PackID)
        
        ZipFCInfo("Type")        = ZipFC(PackID$)\Type
        ZipFCInfo("Description") = ZipFC(PackID$)\Description
        ZipFCInfo("Author")      = ZipFC(PackID$)\Author
        ZipFCInfo("DES")         = ZipFC(PackID$)\DES
        
        DeleteMapElement(ZipFC(), PackID$)
        DeleteDirectory(TempDir$, "*.*", #PB_FileSystem_Force|#PB_FileSystem_Recursive)

        ClosePack(PackID)
        ProcedureReturn #True
      EndIf
      
    EndProcedure
    
    
    Procedure.i CreateContainer(PackID.i, ArchiveFile$, Type$="", Description$="", Author$="", Password$="", Plugin.l=#PB_PackerPlugin_Zip)
      Define Result.i, PackID$ = Str(PackID)
      
      If FileSize(ArchiveFile$) > 0 : ProcedureReturn #False : EndIf ; Container niemals überschreiben
      
      Result = CreateArchive(PackID, ArchiveFile$, Plugin, #Null)
      If Result
        
        If PackID = #PB_Any
          PackID  = Result
          PackID$ = Str(PackID)
        EndIf
        
        If Password$
          Pack(PackID$)\Password = Password$
        EndIf
        
        AddMapElement(Container(), PackID$)
        Container()\PackID = PackID
        Container()\Plugin = Plugin
        Container()\Path   = GetPathPart(ArchiveFile$)
        Container()\File   = GetFilePart(ArchiveFile$)
        If Password$ : Container()\AES = #True : EndIf
        
        AddMapElement(ZipFC(), PackID$)
        ZipFC()\Type        = Type$
        ZipFC()\Description = Description$
        ZipFC()\Author      = Author$
        If Password$ : ZipFC()\DES = DESFingerprint(Password$, #DESKey) : EndIf
        Debug "DES: "+ZipFC()\DES
      EndIf
      
      ProcedureReturn Result
    EndProcedure
    
    Procedure.i OpenContainer(PackID.i, ArchiveFile$, TargetPath$="", Plugin.l=#PB_PackerPlugin_Zip)
      Define Result.i, PackID$ = Str(PackID)
      
      Result = OpenArchive(PackID, ArchiveFile$, Plugin)
      If Result
        
        If PackID = #PB_Any
          PackID = Result
          PackID$ = Str(PackID)
        EndIf
        
        AddMapElement(Container(), PackID$)
        Container()\PackID = PackID
        Container()\Plugin = Plugin
        Container()\File   = ArchiveFile$
        If TargetPath$
          If Right(TargetPath$, 1) <> #Slash : TargetPath$ + #Slash : EndIf
          Container()\Path = TargetPath$
        Else
          Container()\Path = GetPathPart(ArchiveFile$)
        EndIf
        
        LoadZipFCFile(PackID)
        
        ProcedureReturn #True
      EndIf
      
      ProcedureReturn Result
    EndProcedure
    
    Procedure.i AddContainerFile(PackID.i, File$, FileName$="")
      Define Result.i, PackID$ = Str(PackID)
      
      If FileName$ = "" : FileName$ = GetFilePart(File$) : EndIf
      
      AddFile2ZipFC(PackID, File$) ; <-- Add to file list 
      
      If Container(PackID$)\AES = #True
        Result = AddArchiveFile(PackID, File$, FileName$, #Move|#AES)  ; <-- Move file to the archive 
      Else
        Result = AddArchiveFile(PackID, File$, FileName$, #Move)       ; <-- Move file to the archive 
      EndIf
      
      ProcedureReturn Result
    EndProcedure
    
    Procedure.i GetContainerFile(PackID.i, FileName$, Path$="")
      Define PackID$ = Str(PackID)

      If Path$ = "" : Path$ = Container()\Path : EndIf
      If Right(Path$, 1) <> #Slash : Path$ + #Slash : EndIf
      
      If Container(PackID$)\AES ; Container verschlüsselt
        If DecryptFile(PackID, Path$ + FileName$, FileName$)
          Pack(PackID$)\Info(FileName$)\File = Path$ + FileName$
          Pack(PackID$)\Info(FileName$)\Flag = #Extract
        EndIf
      Else
        If UncompressArchiveFile(PackID, Path$ + FileName$, FileName$)
          ProcedureReturn #True
        EndIf
      EndIf
    EndProcedure
    
    Procedure.i RemoveContainerFile(PackID.i, FileName$)
      Define Result.i, PackID$ = Str(PackID)
      
      Result = RemoveArchiveFile(PackID.i, FileName$)                 ; Remove file from archive
      If Result
        DeleteMapElement(ZipFC(PackID$)\Files(), FileName$) ; Remove file from internal ZipFC-MAP
      EndIf
      
      ProcedureReturn Result
    EndProcedure
    
    
    Procedure   CloseContainer(PackID.i)
      Define Result.i, File$, PackID$ = Str(PackID)
      
      ForEach Pack(PackID$)\Info()
        If Pack(PackID$)\Info()\Flag & #Memory : Continue : EndIf 
        If Pack(PackID$)\Info()\Flag & #Extract
          If Container(PackID$)\AES
            Pack(PackID$)\Info()\Flag = #Replace|#Move|#AES
          Else
            Pack(PackID$)\Info()\Flag = #Replace|#Move
          EndIf
          File$ = Pack(PackID$)\Info()\File
          If FindMapElement(ZipFC(PackID$)\Files(), GetFilePart(File$))
            ZipFC(PackID$)\Files()\Size     = FileSize(File$)                       ; Größe aktualisieren
            ZipFC(PackID$)\Files()\Modified = GetFileDate(File$, #PB_Date_Modified) ; Datum aktualisieren
          EndIf
        EndIf
      Next
      
      SaveZipFCFile(PackID)                  ; ZipFCFile für Container generieren
      DeleteMapElement(Container(), PackID$) ; Remove Container from internal MAP
      DeleteMapElement(ZipFC()    , PackID$) ; Remove Container from internal MAP
      
      Pack(PackID$)\Flag = #ReBuild
      
      CloseArchive(PackID)
      
    EndProcedure
    
  CompilerEndIf
  
EndModule

CompilerIf #PB_Compiler_IsMainFile
  
  #PackID = 1
  Define FileCount.i, Error$ 
  
  File1$   = "C:\Windows\notepad.exe"
  File2$   = "C:\Windows\system.ini"
  File3$   = "C:\Windows\write.exe"
  File4$   = "C:\Windows\uninstall.ico"
  ZipFile$ = GetTemporaryDirectory() + "Test.zip"
  
  ; ZIP::UseArchive(#PB_PackerPlugin_Lzma)
  
  If ZIP::CreateArchive(#PackID, ZipFile$, #PB_PackerPlugin_Lzma) ; #PB_PackerPlugin_LZMA
    
    ZIP::AddArchiveFile(#PackID, File1$)
    ZIP::AddArchiveFile(#PackID, File2$)
    ZIP::AddArchiveFile(#PackID, File3$)
    
    Error$ = ZIP::GetLastErrorMessage(#PackID, "DEU")
    If Error$ : Debug "ERROR: "+Error$ : EndIf
    
    ZIP::CloseArchive(#PackID)
  EndIf
  
  If ZIP::GetArchiveContent(ZipFile$, ZIP::Info()) ; #PB_PackerPlugin_Lzma
    Debug "----------------------------------"
    ForEach ZIP::Info()
      Debug "--> " + ZIP::Info()\Name + " ( File size: " + Str(ZIP::Info()\Uncompressed) + " )"
    Next
  EndIf
  
  If ZIP::OpenArchive(#PackID, ZipFile$) ; #PB_PackerPlugin_Lzma
    
    ZIP::AddArchiveFile(#PackID, File4$, GetFilePart(File4$)) ; Adding a new file to the archive
    ZIP::AddArchiveFile(#PackID, File2$, GetFilePart(File2$)) ; Replacing an existing file in the archive
    ZIP::RemoveArchiveFile(#PackID, GetFilePart(File1$))      ; Remove file from archive
    
    Error$ = ZIP::GetLastErrorMessage(#PackID)
    If Error$ : Debug "ERROR: "+Error$ : EndIf
    
    ZIP::CloseArchive(#PackID)
  EndIf
  
  If ZIP::GetArchiveContent(ZipFile$, ZIP::Info()) ; #PB_PackerPlugin_Lzma
    Debug "----------------------------------"
    ForEach ZIP::Info()
      Debug "--> " + ZIP::Info()\Name + " ( File size: " + Str(ZIP::Info()\Uncompressed) + " )"
    Next
  EndIf
  
  DeleteFile(ZipFile$)
  
  CompilerIf ZIP::#ZipPlus_Container
    
    File1$   = "D:\Temp\Test1.pdf"         ; Files are moved to the archive and then deleted !!! 
    File2$   = "D:\Temp\Test2.pdf"         ; Files are moved to the archive and then deleted !!! 
    ZipFile$ = "D:\Temp\FileContainer.zip"
    
      If ZIP::CreateContainer(#PackID, ZipFile$, "MyDocs", "Documents for MyProgram", "MyProgram", "Test")
      
      ZIP::AddContainerFile(#PackID, File1$)
      ZIP::AddContainerFile(#PackID, File2$)
      
      ZIP::CloseContainer(#PackID)
    EndIf
    
    If ZIP::CheckContainerInfo(ZipFile$, ZIP::ZipFCInfo())
      Debug ""
      Debug "====== ZIP File-Container ======"
      Debug "--> Container of type '"+ZIP::ZipFCInfo("Type")+"' ("+ZIP::ZipFCInfo("Author")+")"
      Debug "================================"
    EndIf
    
    If ZIP::OpenContainer(#PackID, ZipFile$)
      
      Debug "--> OpenContainer()"
      Debug ""
      Debug "Type: "          + ZIP::GetContainerInfo(#PackID, ZIP::#Type)
      Debug "Description: "   + ZIP::GetContainerInfo(#PackID, ZIP::#Description)
      Debug "Author: "        + ZIP::GetContainerInfo(#PackID, ZIP::#Author)
      Debug ""
      
      Password$ = InputRequester("Password request", "Enter the password:", "Test")
      If ZIP::CheckPassword(#PackID, Password$)
        FileName$ = GetFilePart(File1$)
        Debug "File: "+FileName$+" - Date: "+FormatDate("%dd.%mm.%yyyy", ZIP::GetFileInfo(#PackID, FileName$, ZIP::#Modified))
        ZIP::GetContainerFile(#PackID, GetFilePart(File1$))
        Debug ""
      Else
        MessageRequester("Password request", "Wrong password!", #PB_MessageRequester_Ok|#PB_MessageRequester_Error)
      EndIf
      
      MessageRequester("ZIP File-Container", "The file was unpacked from the archive."+#LF$+"When the container is closed, it is moved back to the archive.", #PB_MessageRequester_Ok|#PB_MessageRequester_Info)
      
      If ZIP::GetContentInfo(#PackID, ZIP::ZipFCFiles())
        Debug "====== Files in container ======"
        ForEach ZIP::ZipFCFiles()
          Debug "-> " + ZIP::ZipFCFiles()\Name + "  (Size: " + Str(ZIP::ZipFCFiles()\Size) + ")"
        Next
        Debug "================================"
      EndIf
      
      ZIP::CloseContainer(#PackID)
    EndIf
  
  CompilerEndIf
  
CompilerEndIf
Update: ZIP File Container added
BugFix: #Archive -> #Archiv
Added: ZIP::CheckContainerFiles() / ZIP::GetContentInfo() / ZIP::GetFileInfo()
Added: Password support for archives and containers through file encryption
Last edited by Thorsten1867 on Sat Oct 14, 2017 12:04 pm, edited 10 times in total.
Translated with http://www.DeepL.com/Translator

Download of PureBasic - Modules
Download of PureBasic - Programs

[Windows 11 x64] [PB V5.7x]
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: [Module] ZipPlusModule.pbi

Post by davido »

@Thorsten1867,

Tried running ZipPlusModule, but go the following error:

[13:30:14] [COMPILER] Line 47: Constant not found: #Single.

Using Windows 10 with PureBasic 5.61.
DE AA EB
User avatar
Thorsten1867
Addict
Addict
Posts: 1366
Joined: Wed Aug 24, 2005 4:02 pm
Location: Germany

Re: [Module] ZipPlusModule.pbi

Post by Thorsten1867 »

davido wrote:@Thorsten1867,

Tried running ZipPlusModule, but go the following error:

[13:30:14] [COMPILER] Line 47: Constant not found: #Single.
==> Bug fixed
Translated with http://www.DeepL.com/Translator

Download of PureBasic - Modules
Download of PureBasic - Programs

[Windows 11 x64] [PB V5.7x]
User avatar
Thorsten1867
Addict
Addict
Posts: 1366
Joined: Wed Aug 24, 2005 4:02 pm
Location: Germany

Re: [Module] ZipPlusModule.pbi

Post by Thorsten1867 »

Update: ZIP File Container

- A file container stores the compressed files or documents of a program.
- The container contains additional information (type / description / author), which can be read out.
- All files that have been unpacked for use by the program are moved back there, when the container is closed.
Translated with http://www.DeepL.com/Translator

Download of PureBasic - Modules
Download of PureBasic - Programs

[Windows 11 x64] [PB V5.7x]
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: [Module] ZipPlusModule.pbi

Post by davido »

@Thorsten1867,
Thank you for the update.
The problem with the constants: #Single and #Multiple has now gone away.
However, now a problem occurs with #Archive.

I noticed that you have a constant: #Archiv, so I changed all the #Archive occurrences to #Archiv, and the program then ran ok.

It looks good. :D
DE AA EB
User avatar
Thorsten1867
Addict
Addict
Posts: 1366
Joined: Wed Aug 24, 2005 4:02 pm
Location: Germany

Re: [Module] ZipPlusModule.pbi

Post by Thorsten1867 »

Update: ZIP file container

- A file container stores the compressed files or documents of a program.
- The container contains additional information (type / description / author) which can be read out.
- All files that have been unpacked for use by the program are moved back there when the container is closed.
- Password for container possible. If the password is correct, the files are automatically encrypted and decrypted.
Translated with http://www.DeepL.com/Translator

Download of PureBasic - Modules
Download of PureBasic - Programs

[Windows 11 x64] [PB V5.7x]
User avatar
Lunasole
Addict
Addict
Posts: 1091
Joined: Mon Oct 26, 2015 2:55 am
Location: UA
Contact:

Re: [Module] ZipPlusModule.pbi

Post by Lunasole »

Hi. Played a bit with this stuff, here are few moments:

This line from EncryptFile() procedure:
If AESEncoder(*FileMemory, *MemoryBuffer, MemorySize(*FileMemory), @Password$, 128, #False, #PB_Cipher_ECB)
Here bad AES mode used (better turn that CBC + set some initvector, for example generate it from password data)

Here @Password possibly can read trash from memory and make file decryption impossible, if defined password was too short. Do some string padding in SetPassword(), to make sure it len is always 32 bytes (good idea is to calculate SHA-2 of entered string, or some other hash which in binary form has 32 bytes. or use MD5 in string form).

Anyway it's bad idea to store password as unicode string, as every second byte will be 0. So only first 16 characters of string are used for 128-bit key. Use Array of bytes or ASCII string/memory to store it

Also flags for AddArchiveFile() are inaccessible from public space. Probably they have to be in Declares? (I don't know, almost never build own modules^^)
"W̷i̷s̷h̷i̷n̷g o̷n a s̷t̷a̷r"
User avatar
Thorsten1867
Addict
Addict
Posts: 1366
Joined: Wed Aug 24, 2005 4:02 pm
Location: Germany

Re: [Module] ZipPlusModule.pbi

Post by Thorsten1867 »

Lunasole wrote:Also flags for AddArchiveFile() are inaccessible from public space. Probably they have to be in Declares? (I don't know, almost never build own modules^^)
Fixed: ZIP::#Move / ZIP::#AES

Added flag #SHA2 to password routines.
Translated with http://www.DeepL.com/Translator

Download of PureBasic - Modules
Download of PureBasic - Programs

[Windows 11 x64] [PB V5.7x]
User avatar
blueb
Addict
Addict
Posts: 1044
Joined: Sat Apr 26, 2003 2:15 pm
Location: Cuernavaca, Mexico

Re: [Module] ZipPlusModule.pbi

Post by blueb »

Sorry... I'm not seeing your changes. :?:
- It was too lonely at the top.

System : PB 6.10 LTS (x64) and Win Pro 11 (x64)
Hardware: AMD Ryzen 9 5900X w/64 gigs Ram, AMD RX 6950 XT Graphics w/16gigs Mem
Post Reply