PureBasic

Bonjour à tous,

Une petite librairie pour ajouter des fonctions supplémentaires pour les fichiers *.pack. L'idée au départ était d'ajouter une fonction pour compresser la taille d'un tableau ou d'une liste chaînée ainsi que le nom des fichiers avec les fichiers inclus dans une archive. Par la suite, j'ai décidé d'ajouter une fonction pour chacun des types standards même si j'avais seulement besoin des commandes AddPackLong() / UnPackLong() et AddPackString() / UnPackString().

En espérant qu'elle pourra être utile à quelqu'un.

A+
Guimauve

Code : Tout sélectionner

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : Packer - Extra Function
; File Name : Packer - Extra Function.pb
; File version: 1.0.0
; Programmation : OK
; Programmed by : Guimauve
; Date : 26-05-2011
; Mise à jour : 26-05-2011
; PureBasic cade : 4.50
; Plateform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<
; <<<<< Packing <<<<<

Procedure AddPackByte(Var.b, Level.b = 6)
  
  Byte.Byte\b = Var
  AddPackMemory(Byte, SizeOf(Byte), Level)
  
EndProcedure

Procedure AddPackAscii(Var.a, Level.b = 6)
  
  Ascii.Ascii\a = Var
  AddPackMemory(Ascii, SizeOf(Ascii), Level)
  
EndProcedure

Procedure AddPackCharacter(Var.c, Level.b = 6)
  
  Character.Character\c = Var
  AddPackMemory(Character, SizeOf(Character), Level)
  
EndProcedure

Procedure AddPackUnicode(Var.u, Level.b = 6)
  
  Unicode.Unicode\u = Var
  AddPackMemory(Unicode, SizeOf(Unicode), Level)
  
EndProcedure

Procedure AddPackWord(Var.w, Level.b = 6)
  
  Word.Word\w = Var
  AddPackMemory(Word, SizeOf(Word), Level)
  
EndProcedure

Procedure AddPackInteger(Var.i, Level.b = 6)
  
  Integer.Integer\i = Var
  AddPackMemory(Integer, SizeOf(Integer), Level)
  
EndProcedure

Procedure AddPackLong(Var.l, Level.b = 6)
  
  Long.Long\l = Var
  AddPackMemory(Long, SizeOf(Long), Level)
  
EndProcedure

Procedure AddPackQuad(Var.q, Level.b = 6)
  
  Quad.Quad\q = Var
  AddPackMemory(Quad, SizeOf(Quad), Level)
  
EndProcedure

Procedure AddPackFloat(Var.f, Level.b = 6)
  
  Float.Float\f = Var
  AddPackMemory(Float, SizeOf(Float), Level)
  
EndProcedure

Procedure AddPackDouble(Var.d, Level.b = 6)
  
  Double.Double\d = Var
  AddPackMemory(Double, SizeOf(Double), Level)
  
EndProcedure

Procedure AddPackString(String.s, Level.b = 6)
  
  CompilerIf #PB_Compiler_Unicode
    StringLen.l = Len(String) * 2
  CompilerElse
    StringLen.l = Len(String)
  CompilerEndIf 
  
  AddPackMemory(@String, StringLen, Level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<
; <<<<< UnPacking <<<<<

Procedure.b UnPackByte()
  
  Var.i = NextPackFile()
  
  ProcedureReturn PeekB(Var)
EndProcedure

Procedure.a UnPackAscii()
  
  Var.i = NextPackFile()
  
  ProcedureReturn PeekA(Var)
EndProcedure

Procedure.c UnPackCharacter()
  
  Var.i = NextPackFile()
  
  ProcedureReturn PeekC(Var)
EndProcedure

Procedure.u UnPackUnicode()
  
  Var.i = NextPackFile()
  
  ProcedureReturn PeekU(Var)
EndProcedure

Procedure.w UnPackWord()
  
  Var.i = NextPackFile()
  
  ProcedureReturn PeekW(Var)
EndProcedure

Procedure.i UnPackInteger()
  
  Var.i = NextPackFile()
  
  ProcedureReturn PeekI(Var) 
EndProcedure

Procedure.l UnPackLong()
  
  Var.i = NextPackFile()
  
  ProcedureReturn PeekL(Var)
EndProcedure

Procedure.q UnPackQuad()
  
  Var.i = NextPackFile()
  
  ProcedureReturn PeekQ(Var)
EndProcedure

Procedure.f UnPackFloat()
  
  Var.i = NextPackFile()
  
  ProcedureReturn PeekF(Var)
EndProcedure

Procedure.d UnPackDouble()
  
  Var.i = NextPackFile()
  
  ProcedureReturn PeekD(Var)
EndProcedure

Procedure.s UnPackString()
  
  CompilerIf #PB_Compiler_Unicode
    Options = #PB_Unicode
  CompilerElse
    Options = #PB_Ascii
  CompilerEndIf 
  
  String.i = NextPackFile()
  StringLen.l = PackFileSize()
  
  ProcedureReturn PeekS(String, StringLen, Options)
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
; <<<<< !!! WARNING - YOU ARE NOW IN A TESTING ZONE - WARNING !!! <<<<< 
; <<<<< !!! WARNING - THIS CODE SHOULD BE COMMENTED - WARNING !!! <<<<< 
; <<<<< !!! WARNING - BEFORE THE FINAL COMPILATION. - WARNING !!! <<<<< 
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 

If CreatePack("Test.pak")
  
  AddPackByte(125, 9)
  AddPackAscii(250, 9)
  AddPackCharacter(251, 9)
  AddPackUnicode(65000, 9)
  AddPackWord(-15000, 9)
  AddPackInteger(2147483647, 9)
  AddPackLong(2147483640, 9)
  AddPackQuad(9223372036854775807, 9)
  AddPackFloat(2*#PI, 9)
  AddPackDouble(4*#PI, 9)
  AddPackString("PureBasic", 9)
  
  ClosePack()
  
EndIf

If OpenPack("Test.pak")
  
  Debug UnPackByte()
  Debug UnPackAscii()
  Debug UnPackCharacter()
  Debug UnPackUnicode()
  Debug UnPackWord()
  Debug UnPackInteger()
  Debug UnPackLong()
  Debug UnPackQuad()
  Debug UnPackFloat()
  Debug UnPackDouble()
  Debug UnPackString()
  
  ClosePack()
  
EndIf

DeleteFile("Test.pak")

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Re-Bonjour à tous,

Voici une version ZLIB de la librarie "Packer Extra Function" inspiré d'un code fourni par ts-soft sur le forum anglais. En théorie, cette librairie devrait permettre la compression sous un OS (Windows par exemple) et la décompression sous un autre OS (Linux Mint 11 par exemple). Étant donnée que je n'ai pas de machine MacOS je ne peux donc pas dire si cette lib fonction sous ce système.

Désolé pour les commentaires en anglais.

A+
Guimauve

Code : Tout sélectionner

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : ZLIB Pack Command
; File Name : ZLIB Pack Command.pb
; File version: 1.0.0
; Programmation : OK
; Programmed by : Guimauve
; Date : 07-07-2011
; Last Update : 07-07-2011
; PureBasic code : 4.60
; Plateform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Additionnal authors :
;
; Thomas (ts-soft) Schulz 
; jamirokwai
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Command Importation from zlib file <<<<<

CompilerSelect #PB_Compiler_OS
    
  CompilerCase #PB_OS_Linux
    #ZLIB_IMPORT_PATH = #PB_Compiler_Home + "purelibraries/linux/libraries/zlib.a"
    
  CompilerCase #PB_OS_Windows
    #ZLIB_IMPORT_PATH = "zlib.lib"
    
  CompilerCase #PB_OS_MacOS
    #ZLIB_IMPORT_PATH = "/usr/lib/libz.dylib"
    
CompilerEndSelect

ImportC #ZLIB_IMPORT_PATH
  
  compress2(*Destination.i, *DestinationLength.i, *Source.i, SourceLength.l, level.l)
  uncompress(*Destination.i, *DestinationLength.i, *Source.i, SourceLength.l)
  
EndImport

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< (Private) Compress memory block <<<<<

Procedure ZLIB_Private_Compress(*Source.i, SourceLength.l, level.l)
  
  Protected *Destination.i, DestinationLength.i
  
  If level < 0 Or level > 9 
    level = 6 
  EndIf
  
  If *Source <> #Null
    
    If SourceLength = #PB_Default
      SourceLength = MemorySize(*Source) 
    EndIf
    
    DestinationLength = SourceLength + 13 + (Int(SourceLength / 100))
    
    *Destination = AllocateMemory(DestinationLength)
    
    If *Destination <> #Null
      
      If Not compress2(*Destination, @DestinationLength, *Source, SourceLength, level)
        *Destination = ReAllocateMemory(*Destination, DestinationLength)
      EndIf
      
    EndIf
    
  EndIf
  
  ProcedureReturn *Destination
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< (Private) Decompress memory block <<<<<

Procedure.l ZLIB_Private_Decompress(*Source.i, *Destination.i)
  
  Protected SourceLength = MemorySize(*Source)
  Protected DestinationLength = MemorySize(*Destination)
  
  If Not uncompress(*Destination, @DestinationLength, *Source, SourceLength)
    Result.l = DestinationLength
  Else 
    Result = 0
  EndIf
  
  ProcedureReturn Result
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Create PackFile <<<<<

Procedure ZLIB_CreatePack(P_FileName.s)
  
  Shared ZLIB_PackFileID, ZLIB_PackFileSize, ZLIB_MemoryDecompress
  
  If IsFile(ZLIB_PackFileID) ; Si la librarie à ouvert un fichier sans le refermer, on le referme
    CloseFile(ZLIB_PackFileID)
  EndIf 
  
  ZLIB_PackFileID = CreateFile(#PB_Any, P_FileName)
  
  ProcedureReturn ZLIB_PackFileID
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Append Pack File <<<<<

Procedure ZLIB_AppendPack(P_FileName.s)
  
  Shared ZLIB_PackFileID, ZLIB_PackFileSize, ZLIB_MemoryDecompress
  
  If IsFile(ZLIB_PackFileID) ; Si la librarie à ouvert un fichier sans le refermer, on le referme
    CloseFile(ZLIB_PackFileID)
  EndIf 
  
  ZLIB_PackFileID = OpenFile(#PB_Any, P_FileName)
  
  FileSeek(ZLIB_PackFileID, Lof(ZLIB_PackFileID))
  
  ProcedureReturn ZLIB_PackFileID
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Open Pack file <<<<<

Procedure ZLIB_OpenPack(P_FileName.s)
  
  Shared ZLIB_PackFileID, ZLIB_PackFileSize, ZLIB_MemoryDecompress
  
  If IsFile(ZLIB_PackFileID)
    CloseFile(ZLIB_PackFileID)
  EndIf 
  
  ZLIB_PackFileID = ReadFile(#PB_Any, P_FileName)
  
  ProcedureReturn ZLIB_PackFileID
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Close Pack file <<<<<

Procedure ZLIB_ClosePack()
  
  Shared ZLIB_PackFileID, ZLIB_PackFileSize, ZLIB_MemoryDecompress
  
  If ZLIB_MemoryDecompress <> #Null
    FreeMemory(ZLIB_MemoryDecompress)
  EndIf
  
  If IsFile(ZLIB_PackFileID)
    CloseFile(ZLIB_PackFileID)
    ZLIB_PackFileID = 0
  EndIf 
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Add Pack Memory <<<<<

Procedure ZLIB_AddPackMemory(*Source.i, SourceLength.l, level.l = 6)
  
  Shared ZLIB_PackFileID, ZLIB_PackFileSize, ZLIB_MemoryDecompress
 
  If *Source <> #Null
    
    ZLIB_MemoryCompressed = ZLIB_Private_Compress(*Source, SourceLength, level)
    MemoryCompressedLength = MemorySize(ZLIB_MemoryCompressed)
    WriteLong(ZLIB_PackFileID, MemoryCompressedLength)
    WriteData(ZLIB_PackFileID, ZLIB_MemoryCompressed, MemoryCompressedLength)
    
    If ZLIB_MemoryCompressed <> #Null
      FreeMemory(ZLIB_MemoryCompressed)
    EndIf  
    
  EndIf
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Add Pack File <<<<<

Procedure ZLIB_AddPackFile(FileName.s, Level.l = 6)
  
  Shared ZLIB_PackFileID, ZLIB_PackFileSize, ZLIB_MemoryDecompress

  File_To_Pack_ID = ReadFile(#PB_Any, FileName)
  
  If IsFile(File_To_Pack_ID)
    
    File_To_Pack_Length = Lof(File_To_Pack_ID) 
    File_To_Pack_Memory = AllocateMemory(File_To_Pack_Length)
    
    ReadData(File_To_Pack_ID, File_To_Pack_Memory, File_To_Pack_Length)
    CloseFile(File_To_Pack_ID)
    
    ZLIB_MemoryCompressed = ZLIB_Private_Compress(File_To_Pack_Memory, File_To_Pack_Length, level)
    
    WriteLong(ZLIB_PackFileID, File_To_Pack_Length)
    WriteData(ZLIB_PackFileID, ZLIB_MemoryCompressed, MemorySize(ZLIB_MemoryCompressed))
    
    If ZLIB_MemoryCompressed <> #Null
      FreeMemory(ZLIB_MemoryCompressed)
    EndIf  
    
    If File_To_Pack_Memory <> #Null
      FreeMemory(File_To_Pack_Memory)
    EndIf
    
  EndIf
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Add Pack Byte <<<<<

Procedure ZLIB_AddPackByte(Value.b, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Byte), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Add Pack Ascii <<<<<

Procedure ZLIB_AddPackAscii(Value.a, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Ascii), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Add Pack Character <<<<<

Procedure ZLIB_AddPackCharacter(Value.c, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Character), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Add Pack Unicode <<<<<

Procedure ZLIB_AddPackUnicode(Value.u, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Unicode), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Add Pack Word <<<<<

Procedure ZLIB_AddPackWord(Value.w, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Word), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Add Pack Long <<<<<

Procedure ZLIB_AddPackLong(Value.l, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Long), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Add Pack Integer <<<<<

Procedure ZLIB_AddPackInteger(Value.i, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Integer), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Add Pack Quad <<<<<

Procedure ZLIB_AddPackQuad(Value.q, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Quad), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Add Pack Float <<<<<

Procedure ZLIB_AddPackFloat(Value.f, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Float), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Add Pack Double <<<<<

Procedure ZLIB_AddPackDouble(Value.d, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Double), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Add Pack String <<<<<

Procedure ZLIB_AddPackString(String.s, level.l = 6)
  
  Max = Len(String)
  
  *Source.i = AllocateMemory(Max * SizeOf(Word))
  *SourcePtr.i = *Source
  
  For Index = 1 To Max
    PokeW(*SourcePtr, Asc(Mid(String, Index, 1)))
    *SourcePtr + SizeOf(Word)
  Next
  
  ZLIB_AddPackMemory(*Source, MemorySize(*Source), level)

  If *Source <> #Null
    FreeMemory(*Source)
  EndIf 

EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Unpack Next Packed File <<<<<

Procedure.i ZLIB_NextPackFile()
  
  Shared ZLIB_PackFileID, ZLIB_PackFileSize, ZLIB_MemoryDecompress
  
  If ZLIB_MemoryDecompress <> #Null
    FreeMemory(ZLIB_MemoryDecompress)
  EndIf
  
  ZLIB_MemorySize.l = ReadLong(ZLIB_PackFileID)
  ZLIB_MemoryCompressed = AllocateMemory(ZLIB_MemorySize)
  ZLIB_MemoryDecompress = AllocateMemory(ZLIB_MemorySize)
  
  ReadData(ZLIB_PackFileID, ZLIB_MemoryCompressed, ZLIB_MemorySize)
  
  ZLIB_PackFileSize = ZLIB_Private_Decompress(ZLIB_MemoryCompressed, ZLIB_MemoryDecompress)
  
  If ZLIB_MemoryCompressed <> #Null
    FreeMemory(ZLIB_MemoryCompressed)
  EndIf 
  
  ProcedureReturn ZLIB_MemoryDecompress
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Last Pack File Size <<<<<

Procedure.l ZLIB_PackFileSize()
  
  Shared ZLIB_PackFileID, ZLIB_PackFileSize, ZLIB_MemoryDecompress
  
  ProcedureReturn ZLIB_PackFileSize
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< UnPack Byte <<<<<

Procedure.b ZLIB_UnPackByte()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekB(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< UnPack Ascii <<<<<

Procedure.a ZLIB_UnPackAscii()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekA(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< UnPack Character <<<<<

Procedure.c ZLIB_UnPackCharacter()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekC(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< UnPack Unicode <<<<<

Procedure.u ZLIB_UnPackUnicode()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekU(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< UnPack Word <<<<<

Procedure.w ZLIB_UnPackWord()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekW(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< UnPack Integer <<<<<

Procedure.i ZLIB_UnPackInteger()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekI(Var) 
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< UnPack Long <<<<<

Procedure.l ZLIB_UnPackLong()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekL(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< UnPack Quad <<<<<

Procedure.q ZLIB_UnPackQuad()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekQ(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< UnPack Float <<<<<

Procedure.f ZLIB_UnPackFloat()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekF(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< UnPack Double <<<<<

Procedure.d ZLIB_UnPackDouble()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekD(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< UnPack String <<<<<

Procedure.s ZLIB_UnPackString()
  
  *Source.i = ZLIB_NextPackFile()
  Max.l = ZLIB_PackFileSize() / SizeOf(Word)
  
  For Index = 1 To Max
    String.s = String + Chr(PeekW(*Source))
    *Source + SizeOf(Word)
  Next
  
  ProcedureReturn String
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
; <<<<< !!! WARNING - YOU ARE NOW IN A TESTING ZONE - WARNING !!! <<<<< 
; <<<<< !!! WARNING - THIS CODE SHOULD BE COMMENTED - WARNING !!! <<<<< 
; <<<<< !!! WARNING - BEFORE THE FINAL COMPILATION. - WARNING !!! <<<<< 
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Now we create an image file then save it on disc to simulate
; creating a pack file with file loaded from a folder somehere.

If CreateImage(0, 256,256)
  
  If StartDrawing(ImageOutput(0))
    
    Box(0, 0, 256,256, $FFFFFF)
    
    DrawingMode(#PB_2DDrawing_Gradient)      
    BackColor($00FFFF)
    FrontColor($FF0000)
    
    LinearGradient(0, 0, 256, 256)    
    Circle(100, 100, 100)   
    LinearGradient(350, 100, 250, 100)
    Circle(300, 100, 100)
    
    StopDrawing() 
    
  EndIf 
  
  SaveImage(0, "Texture.bmp")
  
EndIf 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Now we create the *.zpk file

If ZLIB_CreatePack("Test.zpk")
  
  ZLIB_AddPackByte(125, 9)
  ZLIB_AddPackAscii(250, 9)
  ZLIB_AddPackCharacter(251, 9)
  ZLIB_AddPackUnicode(65000, 9)
  ZLIB_AddPackWord(-15000, 9)
  ZLIB_AddPackInteger(2147483647, 9)
  ZLIB_AddPackLong(2147483640, 9)
  ZLIB_AddPackQuad(9223372036854775807, 9)
  ZLIB_AddPackFloat(2*#PI, 9)
  ZLIB_AddPackDouble(4*#PI, 9)
  ZLIB_AddPackString("PureBasic 4.60 Beta 3", 9)
  ZLIB_AddPackString("Texture2.bmp", 9) ; The file name is different, it's just for the exemple
  ZLIB_AddPackFile("Texture.bmp", 9)
  
  ZLIB_ClosePack()
  
EndIf

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; And now we open the *.zpk file

If ZLIB_OpenPack("Test.zpk")
  
  Debug ZLIB_UnPackByte()
  Debug ZLIB_UnPackAscii()
  Debug ZLIB_UnPackCharacter()
  Debug ZLIB_UnPackUnicode()
  Debug ZLIB_UnPackWord()
  Debug ZLIB_UnPackInteger()
  Debug ZLIB_UnPackLong()
  Debug ZLIB_UnPackQuad()
  Debug ZLIB_UnPackFloat()
  Debug ZLIB_UnPackDouble()
  Debug ZLIB_UnPackString()
  
  FileName.s = ZLIB_UnPackString()
  File.i = ZLIB_NextPackFile()

  If CreateFile(0, FileName)
    WriteData(0, File, MemorySize(File))
    CloseFile(0)  
  EndIf
  
  ZLIB_ClosePack()
  
EndIf

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Merci GUIMAUVE

Merci pour ce boulot Guimauve.

Bonjour à tous,

J'ai oublié de mentionner que j'ai ajouté un commande par rapport à la librairie Packer standard pour ajouter des éléments à une archive déjà créée.

Exemple :

Code : Tout sélectionner

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Now we create the *.zpk file

If ZLIB_CreatePack("Test.zpk")
  
  ZLIB_AddPackByte(125, 9)
  ZLIB_AddPackAscii(250, 9)
  ZLIB_AddPackCharacter(251, 9)
  ZLIB_AddPackUnicode(65000, 9)
  ZLIB_AddPackWord(-15000, 9)
  
  ZLIB_ClosePack()
  
EndIf

If ZLIB_AppendPack("Test.zpk")
  
  ZLIB_AddPackInteger(2147483647, 9)
  ZLIB_AddPackLong(2147483640, 9)
  ZLIB_AddPackQuad(9223372036854775807, 9)
  ZLIB_AddPackFloat(2*#PI, 9)
  ZLIB_AddPackDouble(4*#PI, 9)
  ZLIB_AddPackString("PureBasic 4.60 Beta 3", 9)
  ZLIB_AddPackString("Texture2.bmp", 9) ; The file name is different, it's just for the exemple
  ZLIB_AddPackFile("Texture.bmp", 9)
  
  ZLIB_ClosePack()
  
EndIf

Bien entendu il s'agit d'un exemple mais le principe est là.

A+
Guimauve

Bonjour à tous,

Nouvelle version avec quelques commandes en extra et une vérification CRC32FingerPrint() des blocs mémoire.

A+
Guimauve

Code : Tout sélectionner

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : ZLIB Pack Command
; File Name : ZLIB Pack Command.pb
; File version: 1.1.0
; Programmation : OK
; Programmed by : Guimauve
; Date : 07-07-2011
; Last Update : 27-07-2011
; PureBasic code : 4.60
; Plateform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Additionnal authors :
;
; Thomas (ts-soft) Schulz 
; jamirokwai
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Définition des constantes <<<<<

#ZLIB_OK = 0
#ZLIB_STREAM_END = 1
#ZLIB_NEED_DICT = 2

#ZLIB_ERRNO = -1
#ZLIB_STREAM_ERROR = -2
#ZLIB_DATA_ERROR = -3
#ZLIB_MEM_ERROR = -4
#ZLIB_BUF_ERROR = -5
#ZLIB_VERSION_ERROR = -6
#ZLIB_CRC32_ERROR = -15

#ZLIB_NO_COMPRESSION = 0
#ZLIB_BEST_SPEED = 1
#ZLIB_BEST_COMPRESSION = 9
#ZLIB_DEFAULT_COMPRESSION = -1

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Importation des commandes depuis la librairie <<<<<

CompilerSelect #PB_Compiler_OS
    
  CompilerCase #PB_OS_Linux
    #ZLIB_IMPORT_PATH = #PB_Compiler_Home + "purelibraries/linux/libraries/zlib.a"
    
  CompilerCase #PB_OS_Windows
    #ZLIB_IMPORT_PATH = "zlib.lib"
    
  CompilerCase #PB_OS_MacOS
    #ZLIB_IMPORT_PATH = "/usr/lib/libz.dylib"
    
CompilerEndSelect

ImportC #ZLIB_IMPORT_PATH
  
  compress2(*Destination.i, *DestinationLength.i, *Source.i, SourceLength.l, Level.l)
  uncompress(*Destination.i, *DestinationLength.i, *Source.i, SourceLength.l)
  
EndImport

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Compression Zone Mémoire <<<<<

Procedure ZLIB_Private_Compress(*Source.i, SourceLength.l, Level.l)
  
  Shared ZLIB_LAST_ERROR.b
  
  If level < #ZLIB_NO_COMPRESSION Or level > #ZLIB_BEST_COMPRESSION
    level = #ZLIB_DEFAULT_COMPRESSION
  EndIf
  
  If *Source <> #Null
    
    If SourceLength = #PB_Default
      SourceLength = MemorySize(*Source) 
    EndIf
    
    DestinationLength = SourceLength + 13 + (Int(SourceLength / 100))
    
    *Destination = AllocateMemory(DestinationLength)
    
    If *Destination <> #Null
      
      ZLIB_LAST_ERROR = compress2(*Destination, @DestinationLength, *Source, SourceLength, Level)
      
      If Not ZLIB_LAST_ERROR 
        *Destination = ReAllocateMemory(*Destination, DestinationLength)
      EndIf
      
    EndIf
    
  EndIf
  
  ProcedureReturn *Destination
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Décompression Zone Mémoire <<<<<

Procedure.l ZLIB_Private_Decompress(*Source.i, *Destination.i)
  
  Shared ZLIB_LAST_ERROR.b
  
  Protected SourceLength = MemorySize(*Source)
  Protected DestinationLength = MemorySize(*Destination)
  
  ZLIB_LAST_ERROR = uncompress(*Destination, @DestinationLength, *Source, SourceLength)
  
  If Not ZLIB_LAST_ERROR
    Result.l = DestinationLength
  Else 
    Result = 0
  EndIf
  
  ProcedureReturn Result
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Obtenir la dernière Erreur <<<<<

Procedure.b ZLIB_Private_LastError()
  
  Shared ZLIB_LAST_ERROR.b
  
  ReturnValue.b = ZLIB_LAST_ERROR
  ZLIB_LAST_ERROR = #ZLIB_OK
  
  ProcedureReturn ReturnValue
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Création d'un fichier <<<<<

Procedure ZLIB_CreatePack(P_FileName.s)
  
  Shared ZLIB_PackFileID, ZLIB_PackFileSize, ZLIB_MemoryDecompress, ZLIB_Last_Error
  
  If IsFile(ZLIB_PackFileID) ; Si la librarie à ouvert un fichier sans le refermer, on le referme
    CloseFile(ZLIB_PackFileID)
  EndIf 
  
  ZLIB_PackFileID = CreateFile(#PB_Any, P_FileName)
  
  ProcedureReturn ZLIB_PackFileID
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Ourverture d'un fichier pour ajout <<<<<

Procedure ZLIB_AppendPack(P_FileName.s)
  
  Shared ZLIB_PackFileID, ZLIB_PackFileSize, ZLIB_MemoryDecompress, ZLIB_Last_Error
  
  If IsFile(ZLIB_PackFileID) ; Si la librarie à ouvert un fichier sans le refermer, on le referme
    CloseFile(ZLIB_PackFileID)
  EndIf 
  
  ZLIB_PackFileID = OpenFile(#PB_Any, P_FileName)
  
  FileSeek(ZLIB_PackFileID, Lof(ZLIB_PackFileID))
  
  ZLIB_Last_Error = #ZLIB_OK
  
  ProcedureReturn ZLIB_PackFileID
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Ouverture d'un fichier <<<<<

Procedure ZLIB_OpenPack(P_FileName.s)
  
  Shared ZLIB_PackFileID, ZLIB_PackFileSize, ZLIB_MemoryDecompress, ZLIB_Last_Error
  
  If IsFile(ZLIB_PackFileID)
    CloseFile(ZLIB_PackFileID)
  EndIf 
  
  ZLIB_PackFileID = ReadFile(#PB_Any, P_FileName)
  
  ZLIB_Last_Error = #ZLIB_OK
  
  ProcedureReturn ZLIB_PackFileID
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Fermeture d'un fichier <<<<<

Procedure ZLIB_ClosePack()
  
  Shared ZLIB_PackFileID, ZLIB_PackFileSize, ZLIB_MemoryDecompress, ZLIB_Last_Error
  
  If ZLIB_MemoryDecompress <> #Null
    FreeMemory(ZLIB_MemoryDecompress)
  EndIf
  
  If IsFile(ZLIB_PackFileID)
    CloseFile(ZLIB_PackFileID)
    ZLIB_PackFileID = 0
  EndIf 
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Ajouter un bloc mémoire à l'archive <<<<<

Procedure ZLIB_AddPackMemory(*Source.i, SourceLength.l, level.l = 6)
  
  Shared ZLIB_PackFileID, ZLIB_PackFileSize, ZLIB_MemoryDecompress, ZLIB_Last_Error
 
  If *Source <> #Null
    
    ZLIB_MemoryCompressed = ZLIB_Private_Compress(*Source, SourceLength, level)
    ZLIB_Last_Error = ZLIB_Private_LastError()
    MemoryCompressedLength = MemorySize(ZLIB_MemoryCompressed)
    WriteLong(ZLIB_PackFileID, MemoryCompressedLength)
    WriteLong(ZLIB_PackFileID, CRC32Fingerprint(*Source, SourceLength))
    WriteData(ZLIB_PackFileID, ZLIB_MemoryCompressed, MemoryCompressedLength)
    
    If ZLIB_MemoryCompressed <> #Null
      FreeMemory(ZLIB_MemoryCompressed)
    EndIf  
    
  EndIf
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Ajouter un fichier à l'archive <<<<<

Procedure ZLIB_AddPackFile(FileName.s, Level.l = 6)
  
  Shared ZLIB_PackFileID, ZLIB_PackFileSize, ZLIB_MemoryDecompress, ZLIB_Last_Error

  File_To_Pack_ID = ReadFile(#PB_Any, FileName)
  
  If IsFile(File_To_Pack_ID)
    
    File_To_Pack_Length = Lof(File_To_Pack_ID) 
    File_To_Pack_Memory = AllocateMemory(File_To_Pack_Length)
    
    ReadData(File_To_Pack_ID, File_To_Pack_Memory, File_To_Pack_Length)
    CloseFile(File_To_Pack_ID)
    
    ZLIB_MemoryCompressed = ZLIB_Private_Compress(File_To_Pack_Memory, File_To_Pack_Length, level)
    ZLIB_Last_Error = ZLIB_Private_LastError()
    
    WriteLong(ZLIB_PackFileID, File_To_Pack_Length)
    WriteLong(ZLIB_PackFileID, CRC32Fingerprint(File_To_Pack_Memory, File_To_Pack_Length))
    WriteData(ZLIB_PackFileID, ZLIB_MemoryCompressed, MemorySize(ZLIB_MemoryCompressed))
    
    If ZLIB_MemoryCompressed <> #Null
      FreeMemory(ZLIB_MemoryCompressed)
    EndIf  
    
    If File_To_Pack_Memory <> #Null
      FreeMemory(File_To_Pack_Memory)
    EndIf
    
  EndIf
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Ajouter un Byte à l'archive <<<<<

Procedure ZLIB_AddPackByte(Value.b, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Byte), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Ajouter un Ascii à l'archive <<<<<

Procedure ZLIB_AddPackAscii(Value.a, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Ascii), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Ajouter un Character à l'archive <<<<<

Procedure ZLIB_AddPackCharacter(Value.c, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Character), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Ajouter un Unicode à l'archive <<<<<

Procedure ZLIB_AddPackUnicode(Value.u, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Unicode), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Ajouter un Word à l'archive <<<<<

Procedure ZLIB_AddPackWord(Value.w, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Word), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Ajouter un Long à l'archive <<<<<

Procedure ZLIB_AddPackLong(Value.l, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Long), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Ajouter un Integer à l'archive <<<<<

Procedure ZLIB_AddPackInteger(Value.i, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Integer), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Ajouter un Quad à l'archive <<<<<

Procedure ZLIB_AddPackQuad(Value.q, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Quad), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Ajouter un Float à l'archive <<<<<

Procedure ZLIB_AddPackFloat(Value.f, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Float), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Ajouter un Double à l'archive <<<<<

Procedure ZLIB_AddPackDouble(Value.d, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Double), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Ajouter un String à l'archive <<<<<

Procedure ZLIB_AddPackString(String.s, level.l = 6)
  
  Max = Len(String)
  
  *Source.i = AllocateMemory(Max * SizeOf(Word))
  *SourcePtr.i = *Source
  
  For Index = 1 To Max
    PokeW(*SourcePtr, Asc(Mid(String, Index, 1)))
    *SourcePtr + SizeOf(Word)
  Next
  
  ZLIB_AddPackMemory(*Source, MemorySize(*Source), level)
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Extraire et décompresser un fichier <<<<<

Procedure.i ZLIB_NextPackFile()
  
  Shared ZLIB_PackFileID, ZLIB_PackFileSize, ZLIB_MemoryDecompress, ZLIB_Last_Error
  
  If ZLIB_MemoryDecompress <> #Null
    FreeMemory(ZLIB_MemoryDecompress)
  EndIf
  
  ZLIB_MemorySize.l = ReadLong(ZLIB_PackFileID)
  CRC32.l = ReadLong(ZLIB_PackFileID)
  ZLIB_MemoryCompressed = AllocateMemory(ZLIB_MemorySize)
  ZLIB_MemoryDecompress = AllocateMemory(ZLIB_MemorySize)
  
  ReadData(ZLIB_PackFileID, ZLIB_MemoryCompressed, ZLIB_MemorySize)
  
  ZLIB_PackFileSize = ZLIB_Private_Decompress(ZLIB_MemoryCompressed, ZLIB_MemoryDecompress)
  ZLIB_Last_Error = ZLIB_Private_LastError()
  
  If ZLIB_Last_Error = #ZLIB_OK
    
    If CRC32 <> CRC32Fingerprint(ZLIB_MemoryDecompress, ZLIB_PackFileSize)
      ZLIB_Last_Error = #ZLIB_CRC32_ERROR
    EndIf
    
  EndIf
  
  If ZLIB_MemoryCompressed <> #Null
    FreeMemory(ZLIB_MemoryCompressed)
  EndIf 
  
  ProcedureReturn ZLIB_MemoryDecompress
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Retourner la taille du dernier fichier décompressé <<<<<

Procedure.l ZLIB_PackFileSize()
  
  Shared ZLIB_PackFileID, ZLIB_PackFileSize, ZLIB_MemoryDecompress, ZLIB_Last_Error
  
  ProcedureReturn ZLIB_PackFileSize
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Retourner la taille du dernier fichier décompressé <<<<<

Procedure.l ZLIB_PackLastError()
  
  Shared ZLIB_PackFileID, ZLIB_PackFileSize, ZLIB_MemoryDecompress, ZLIB_Last_Error
  
  ProcedureReturn ZLIB_Last_Error
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Extraire et décompresser un Byte <<<<<

Procedure.b ZLIB_UnPackByte()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekB(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Extraire et décompresser un Ascii <<<<<

Procedure.a ZLIB_UnPackAscii()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekA(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Extraire et décompresser un Character <<<<<

Procedure.c ZLIB_UnPackCharacter()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekC(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Extraire et décompresser un Unicode <<<<<

Procedure.u ZLIB_UnPackUnicode()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekU(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Extraire et décompresser un Word <<<<<

Procedure.w ZLIB_UnPackWord()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekW(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Extraire et décompresser un Integer <<<<<

Procedure.i ZLIB_UnPackInteger()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekI(Var) 
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Extraire et décompresser un Long <<<<<

Procedure.l ZLIB_UnPackLong()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekL(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Extraire et décompresser un Quad <<<<<

Procedure.q ZLIB_UnPackQuad()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekQ(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Extraire et décompresser un Float <<<<<

Procedure.f ZLIB_UnPackFloat()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekF(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Extraire et décompresser un Double <<<<<

Procedure.d ZLIB_UnPackDouble()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekD(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Extraire et décompresser un String <<<<<

Procedure.s ZLIB_UnPackString()
  
  *Source.i = ZLIB_NextPackFile()
  Max.l = ZLIB_PackFileSize() / SizeOf(Word)
  
  For Index = 1 To Max
    String.s = String + Chr(PeekW(*Source))
    *Source + SizeOf(Word)
  Next
  
  ProcedureReturn String
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
; <<<<< !!! WARNING - YOU ARE NOW IN A TESTING ZONE - WARNING !!! <<<<< 
; <<<<< !!! WARNING - THIS CODE SHOULD BE COMMENTED - WARNING !!! <<<<< 
; <<<<< !!! WARNING - BEFORE THE FINAL COMPILATION. - WARNING !!! <<<<< 
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Now we create an image file then save it on disc to simulate
; creating a pack file with file loaded from a folder somehere.

If CreateImage(0, 256,256)
  
  If StartDrawing(ImageOutput(0))
    
    Box(0, 0, 256,256, $FFFFFF)
    
    DrawingMode(#PB_2DDrawing_Gradient)      
    BackColor($00FFFF)
    FrontColor($FF0000)
    
    LinearGradient(0, 0, 256, 256)    
    Circle(100, 100, 100)   
    LinearGradient(350, 100, 250, 100)
    Circle(300, 100, 100)
    
    StopDrawing() 
    
  EndIf 
  
  SaveImage(0, "Texture.bmp")
  
EndIf 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Now we create the *.zpk file

If ZLIB_CreatePack("Test.zpk")
  
  ZLIB_AddPackByte(125, 9)
  ZLIB_AddPackAscii(250, 9)
  ZLIB_AddPackCharacter(251, 9)
  ZLIB_AddPackUnicode(65000, 9)
  ZLIB_AddPackWord(-15000, 9)
  
  ZLIB_ClosePack()
  
EndIf

If ZLIB_AppendPack("Test.zpk")
  
  ZLIB_AddPackInteger(2147483647, 9)
  ZLIB_AddPackLong(2147483640, 9)
  ZLIB_AddPackQuad(9223372036854775807, 9)
  ZLIB_AddPackFloat(2*#PI, 9)
  ZLIB_AddPackDouble(4*#PI, 9)
  ZLIB_AddPackString("PureBasic 4.60 Beta 3", 9)
  ZLIB_AddPackString("Texture2.bmp", 9) ; The file name is different, it's just for the exemple
  ZLIB_AddPackFile("Texture.bmp", 9)
  
  ZLIB_ClosePack()
  
EndIf

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; And now we open the *.zpk file

If ZLIB_OpenPack("Test.zpk")
  
  Debug ZLIB_UnPackByte()
  Debug ZLIB_UnPackAscii()
  Debug ZLIB_UnPackCharacter()
  Debug ZLIB_UnPackUnicode()
  Debug ZLIB_UnPackWord()
  Debug ZLIB_UnPackInteger()
  Debug ZLIB_UnPackLong()
  Debug ZLIB_UnPackQuad()
  Debug ZLIB_UnPackFloat()
  Debug ZLIB_UnPackDouble()
  Debug ZLIB_UnPackString()
  
  FileName.s = ZLIB_UnPackString()
  File.i = ZLIB_NextPackFile()

  If CreateFile(0, FileName)
    WriteData(0, File, MemorySize(File))
    CloseFile(0)  
  EndIf
  
  ZLIB_ClosePack()
  
EndIf

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

ça mériterait ça conversion en Lib avec petit fichier d'utilisation.

(même c'est claire).
le nombre de fonction augmentant.

C'est propre,
c'est net,
c'est clair,

comme d'hab Guimauve,

merci

Ar-S a écrit :ça mériterait ça conversion en Lib avec petit fichier d'utilisation. (même c'est claire).
le nombre de fonction augmentant.

Il faudrait peut-être que Fred s'en inspire pour corriger et améliorer la librairie Packer standard : Ajout des commandes, utilisation de l’algorithme ZLIB au-lieu de jCalJ1. Présentement, je travaille sur mon projet de jeu en 3D et je n'ai pas le temps de faire la conversion en Lib, de toute façon je ne travaille plus sous Windows alors compiler une librairie ...

Mais si quelqu'un veut le faire, qu'il ne se gène pas, le code est disponible ici spécialement pour cette raison.

A+
Guimauve

Bonjour à tous,

Suite à une demande sur le forum anglais, je viens de mettre à jour le code pour la ZLIB_Pack. Il y avait un problème à la décompression des données, c'est maintenant corrigé. De plus, j'ai ajouté une commande, ZLIB_Version(), qui retourne le numéro de version sous la forme d'une chaîne de caractère (La version utilisée avec PB sous Linux est la 1.2.3 qui date de 18-07-2005, cependant la librairie a été mise à jour vers la version 1.2.6 le 29 janvier 2012. Une mise à jour serait bien)

Une chose additionnel qu'il faudrait faire serait d'ajouter l'écriture du numéro de version au début du fichier et le comparer à l'ouverture pour ajout (Append) ou à l'ouverture pour extraction (Open). Si le premier numéro diffère, la décompression ou l'ajout d'éléments impossible. Mais bon étant donnée que les commande ne sont pas prévue pour ouvrir une archive standard, je ne pense pas que ce soit nécessaire. Ceci étant dit, je peux l'ajouter si la demande est faite.

Le code à été testé sous LinuxMint 12 x64, sous Windows et MacOS sans problème.

Édition : V2.0.5 Correction de bogue.

A+
Guimauve

Code : Tout sélectionner

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : ZLIB Pack Command
; File Name : ZLIB Pack Command.pb
; File version: 2.0.4
; Programming : OK
; Programmed by : Guimauve
; Date : 07-07-2011
; Last Update : 22-02-2012
; PureBasic code : 4.61 Beta 1
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Additionnal authors :
;
; - Thomas (ts-soft) Schulz 
; - jamirokwai
; - Wilbert
; - skywalk 
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Constants definitions <<<<<

#ZLIB_OK = 0
#ZLIB_STREAM_END = 1
#ZLIB_NEED_DICT = 2

#ZLIB_ERRNO = -1
#ZLIB_STREAM_ERROR = -2
#ZLIB_DATA_ERROR = -3
#ZLIB_MEM_ERROR = -4
#ZLIB_BUF_ERROR = -5
#ZLIB_VERSION_ERROR = -6
#ZLIB_CRC32_ERROR = -15

#ZLIB_NO_COMPRESSION = 0
#ZLIB_BEST_SPEED = 1
#ZLIB_BEST_COMPRESSION = 9
#ZLIB_DEFAULT_COMPRESSION = -1

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Command instruction Import file path <<<<<

CompilerSelect #PB_Compiler_OS
    
  CompilerCase #PB_OS_Linux
    #ZLIB_IMPORT_PATH = #PB_Compiler_Home + "purelibraries/linux/libraries/zlib.a"
    
  CompilerCase #PB_OS_MacOS
    #ZLIB_IMPORT_PATH = "/usr/lib/libz.dylib"
    
  CompilerCase #PB_OS_Windows
    #ZLIB_IMPORT_PATH = "zlib.lib"
    
CompilerEndSelect

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Command instruction Import <<<<<

ImportC #ZLIB_IMPORT_PATH
  
  zlibVersion()
  ;compressBound(UnCompressedLenght.l) ; Bugged in  V1.2.3
  compress2(*Compressed.i, *CompressedLength.i, *UnCompressed.i, UnCompressedLength.l, Level.l)
  uncompress(*UnCompressed.i, *UnCompressedLength.i, *Compressed.i, CompressedLength.l)
  
EndImport

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Globals Variables <<<<<

Global ZLIB_LAST_ERROR.b
Global ZLIB_PACK_FILE_HANDLE.i
Global ZLIB_PACK_FILE_SIZE.l
Global ZLIB_UNPACKED_MEMORY.i

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Prototype to force Add Pack Unicode String <<<<<

Prototype ZLIB_AddPackUnicodeString(Source.p-unicode, SourceLength.l, level.l)

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB CompressBound Patch <<<<<

Macro ZLIB_CompressBound_Patch(UnCompressedLenght)
  
  ; which must be at least 0.1% larger than sourceLen plus 12 bytes
  ; Source : http://www.gzip.org/zlib/manual.html#compress
  
  (Int(Round(1.001 * UnCompressedLenght, #PB_Round_Up)) + 12)
  
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Private Compress Command <<<<<

Procedure ZLIB_Private_Compress(*UnCompressed.i, UnCompressedLength.l, Level.l)
  
  If Level < #ZLIB_NO_COMPRESSION Or Level > #ZLIB_BEST_COMPRESSION
    Level = #ZLIB_DEFAULT_COMPRESSION
  EndIf
  
  If *UnCompressed <> #Null
    
    ; The source is valid, so we have something to compress
    ; let's go make a hole !
    
    ; If the length is not defined we find it.
    
    If UnCompressedLength = #PB_Default
      UnCompressedLength = MemorySize(*UnCompressed) 
    EndIf
    
    CompressedLength = ZLIB_CompressBound_Patch(UnCompressedLength)
    *Compressed = AllocateMemory(CompressedLength)
    
    If *Compressed <> #Null
      
      ZLIB_LAST_ERROR = compress2(*Compressed, @CompressedLength, *UnCompressed, UnCompressedLength, Level)
      
      ; If compress operation is OK, we Reallocate the "*Compressed" Memory buffer accordingly 
      ; to the CompressedLength calculated by compress2() function.
      
      If ZLIB_LAST_ERROR = #ZLIB_OK
        *Compressed = ReAllocateMemory(*Compressed, CompressedLength)
      EndIf
      
    EndIf
    
  EndIf
  
  ProcedureReturn *Compressed
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Private Decompress Command <<<<<

Procedure.l ZLIB_Private_Decompress(*Compressed.i, *UnCompressed.i)
  
  CompressedLength = MemorySize(*Compressed)
  UnCompressedLength = MemorySize(*UnCompressed)
  
  ZLIB_LAST_ERROR = uncompress(*UnCompressed, @UnCompressedLength, *Compressed, CompressedLength)
  
  If ZLIB_LAST_ERROR = #ZLIB_OK
    Result.l = UnCompressedLength
  Else 
    Result = 0
  EndIf
  
  ProcedureReturn Result
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Private Last Error Command <<<<<

Procedure.b ZLIB_Private_Last_Error()
  
  ReturnValue.b = ZLIB_LAST_ERROR
  ZLIB_LAST_ERROR = #ZLIB_OK
  
  ProcedureReturn ReturnValue
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Version Command <<<<<

Procedure.s ZLIB_Version()
  
  VersionBuffer.i = zlibVersion()
  
  If VersionBuffer <> #Null
    Version.s = Space(32)
    Version = PeekS(VersionBuffer, 32, #PB_Ascii)
    ZLIB_LAST_ERROR = #ZLIB_OK
  Else
    Version = ""
    ZLIB_LAST_ERROR = #ZLIB_VERSION_ERROR
  EndIf
  
  ProcedureReturn Version
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Create Pack Command <<<<<

Procedure ZLIB_CreatePack(P_FileName.s)
  
  ; This library can manipulate only one file at time
  ; so if a file is already opened we close it before 
  ; to do anything else.
  
  If IsFile(ZLIB_PACK_FILE_HANDLE)
    CloseFile(ZLIB_PACK_FILE_HANDLE)
  EndIf 
  
  ZLIB_PACK_FILE_HANDLE = CreateFile(#PB_Any, P_FileName)
  
  ProcedureReturn ZLIB_PACK_FILE_HANDLE
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Append Pack Command <<<<<

Procedure ZLIB_AppendPack(P_FileName.s)
  
  ; This library can manipulate only one file at time
  ; so if a file is already opened we close it before 
  ; to do anything else.
  
  If IsFile(ZLIB_PACK_FILE_HANDLE)
    CloseFile(ZLIB_PACK_FILE_HANDLE)
  EndIf 
  
  ZLIB_PACK_FILE_HANDLE = OpenFile(#PB_Any, P_FileName)
  
  FileSeek(ZLIB_PACK_FILE_HANDLE, Lof(ZLIB_PACK_FILE_HANDLE))
  
  ZLIB_LAST_ERROR = #ZLIB_OK
  
  ProcedureReturn ZLIB_PACK_FILE_HANDLE
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Open Pack Command <<<<<

Procedure ZLIB_OpenPack(P_FileName.s)
  
  ; This library can manipulate only one file at time
  ; so if a file is already opened we close it before 
  ; to do anything else.
  
  If IsFile(ZLIB_PACK_FILE_HANDLE)
    CloseFile(ZLIB_PACK_FILE_HANDLE)
  EndIf 
  
  ZLIB_PACK_FILE_HANDLE = ReadFile(#PB_Any, P_FileName)
  
  ZLIB_LAST_ERROR = #ZLIB_OK
  
  ProcedureReturn ZLIB_PACK_FILE_HANDLE
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Close Pack Command <<<<<

Procedure ZLIB_ClosePack()
  
  If ZLIB_UNPACKED_MEMORY <> #Null
    FreeMemory(ZLIB_UNPACKED_MEMORY)
    ZLIB_UNPACKED_MEMORY = #Null
  EndIf
  
  If IsFile(ZLIB_PACK_FILE_HANDLE)
    CloseFile(ZLIB_PACK_FILE_HANDLE)
    ZLIB_PACK_FILE_HANDLE = 0
  EndIf 
  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Add Pack Memory Command <<<<<

Procedure ZLIB_AddPackMemory(*UnCompressed.i, UnCompressedLength.l, level.l = 6)
  
  If *UnCompressed <> #Null
    
    *Compressed = ZLIB_Private_Compress(*UnCompressed, UnCompressedLength, level)
    CompressedLength = MemorySize(*Compressed)
    
    WriteLong(ZLIB_PACK_FILE_HANDLE, UnCompressedLength)
    WriteLong(ZLIB_PACK_FILE_HANDLE, CompressedLength)
    WriteLong(ZLIB_PACK_FILE_HANDLE, CRC32Fingerprint(*UnCompressed, UnCompressedLength))
    WriteData(ZLIB_PACK_FILE_HANDLE, *Compressed, CompressedLength)
    
    If *Compressed <> #Null
      FreeMemory(*Compressed)
    EndIf 
    
  EndIf
  
  ProcedureReturn ZLIB_LAST_ERROR
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Add Pack File Command <<<<<

Procedure ZLIB_AddPackFile(FileName.s, Level.l = 6)
  
  File_To_Pack_Handle = ReadFile(#PB_Any, FileName)
  
  If IsFile(File_To_Pack_Handle)
    
    File_To_Pack_Length = Lof(File_To_Pack_Handle) 
    
    If File_To_Pack_Length    ; Check for 0 length files
      
      *File_To_Pack_Memory.i = AllocateMemory(File_To_Pack_Length)
      ReadData(File_To_Pack_Handle, *File_To_Pack_Memory, File_To_Pack_Length)
      CloseFile(File_To_Pack_Handle)
      ZLIB_AddPackMemory(*File_To_Pack_Memory, File_To_Pack_Length, level)
      
      If File_To_Pack_Memory <> #Null
        FreeMemory(File_To_Pack_Memory)
      EndIf
      
    Else
      ZLIB_LAST_ERROR = #ZLIB_DATA_ERROR
    EndIf
    
  EndIf
  
  ProcedureReturn ZLIB_LAST_ERROR
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Add Pack Byte Command <<<<<

Procedure ZLIB_AddPackByte(Value.b, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Byte), level)
  
  ProcedureReturn ZLIB_LAST_ERROR
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Add Pack Ascii Command <<<<<

Procedure ZLIB_AddPackAscii(Value.a, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Ascii), level)
  
  ProcedureReturn ZLIB_LAST_ERROR
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Add Pack Character Command <<<<<

Procedure ZLIB_AddPackCharacter(Value.c, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Character), level)
  
  ProcedureReturn ZLIB_LAST_ERROR
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Add Pack Unicode Command <<<<<

Procedure ZLIB_AddPackUnicode(Value.u, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Unicode), level)
  
  ProcedureReturn ZLIB_LAST_ERROR
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Add Pack Word Command <<<<<

Procedure ZLIB_AddPackWord(Value.w, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Word), level)
  
  ProcedureReturn ZLIB_LAST_ERROR
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Add Pack Long Command <<<<<

Procedure ZLIB_AddPackLong(Value.l, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Long), level)
  
  ProcedureReturn ZLIB_LAST_ERROR
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Add Pack Integer Command <<<<<

Procedure ZLIB_AddPackInteger(Value.i, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Integer), level)
  
  ProcedureReturn ZLIB_LAST_ERROR
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Add Pack Quad Command <<<<<

Procedure ZLIB_AddPackQuad(Value.q, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Quad), level)
  
  ProcedureReturn ZLIB_LAST_ERROR
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Add Pack Float Command <<<<<

Procedure ZLIB_AddPackFloat(Value.f, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Float), level)
  
  ProcedureReturn ZLIB_LAST_ERROR
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Add Pack Double Command <<<<<

Procedure ZLIB_AddPackDouble(Value.d, level.l = 6)
  
  ZLIB_AddPackMemory(@Value, SizeOf(Double), level)
  
  ProcedureReturn ZLIB_LAST_ERROR
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Add Pack String Command <<<<<

Procedure ZLIB_AddPackString(String.s, level.l = 6)
  
  ZLIB_AddPackUnicodeString.ZLIB_AddPackUnicodeString = @ZLIB_AddPackMemory()
  ZLIB_AddPackUnicodeString(String, Len(String) << 1, level)
  
  ProcedureReturn ZLIB_LAST_ERROR  
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Next Pack File <<<<<

Procedure.i ZLIB_NextPackFile()
  
  If ZLIB_UNPACKED_MEMORY <> #Null
    FreeMemory(ZLIB_UNPACKED_MEMORY)
  EndIf
  
  UnCompressedLength = ReadLong(ZLIB_PACK_FILE_HANDLE)
  
  If UnCompressedLength   ; Check for 0 length files
    CompressedLength = ReadLong(ZLIB_PACK_FILE_HANDLE)
    CRC32.l = ReadLong(ZLIB_PACK_FILE_HANDLE)
    *UnCompressed = AllocateMemory(UnCompressedLength)
    *Compressed = AllocateMemory(CompressedLength)
    ReadData(ZLIB_PACK_FILE_HANDLE, *Compressed, CompressedLength)
    ZLIB_PACK_FILE_SIZE = ZLIB_Private_Decompress(*Compressed, *UnCompressed)
  Else
    ZLIB_LAST_ERROR = #ZLIB_MEM_ERROR
  EndIf
  
  If ZLIB_LAST_ERROR = #ZLIB_OK
    
    If CRC32 <> CRC32Fingerprint(*UnCompressed, ZLIB_PACK_FILE_SIZE)
      ZLIB_LAST_ERROR = #ZLIB_CRC32_ERROR
    EndIf
    
  EndIf
  
  If *Compressed <> #Null
    FreeMemory(*Compressed)
  EndIf 
  
  ZLIB_UNPACKED_MEMORY = *UnCompressed
  
  ProcedureReturn *UnCompressed
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB Pack File Size <<<<<

Procedure.l ZLIB_PackFileSize()
  
  ProcedureReturn ZLIB_PACK_FILE_SIZE
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB UnPack Byte Command <<<<<

Procedure.b ZLIB_UnPackByte()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekB(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB UnPack Ascii Command <<<<<

Procedure.a ZLIB_UnPackAscii()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekA(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB UnPack Character Command <<<<<

Procedure.c ZLIB_UnPackCharacter()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekC(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB UnPack Unicode Command <<<<<

Procedure.u ZLIB_UnPackUnicode()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekU(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB UnPack Word Command <<<<<

Procedure.w ZLIB_UnPackWord()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekW(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB UnPack Integer Command <<<<<

Procedure.i ZLIB_UnPackInteger()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekI(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB UnPack Long Command <<<<<

Procedure.l ZLIB_UnPackLong()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekL(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB UnPack Quad Command <<<<<

Procedure.q ZLIB_UnPackQuad()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekQ(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB UnPack Float Command <<<<<

Procedure.f ZLIB_UnPackFloat()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekF(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB UnPack Double Command <<<<<

Procedure.d ZLIB_UnPackDouble()
  
  Var.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekD(Var)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ZLIB UnPack String Command <<<<<

Procedure.s ZLIB_UnPackString()
  
  *Source.i = ZLIB_NextPackFile()
  
  ProcedureReturn PeekS(*Source, ZLIB_PackFileSize() >> 1, #PB_Unicode)
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
; <<<<< !!! WARNING - YOU ARE NOW IN A TESTING ZONE - WARNING !!! <<<<< 
; <<<<< !!! WARNING - THIS CODE SHOULD BE COMMENTED - WARNING !!! <<<<< 
; <<<<< !!! WARNING - BEFORE THE FINAL COMPILATION. - WARNING !!! <<<<< 
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Now we create an image file then save it on disc to simulate
; creating a pack file with file loaded from a folder somehere.

If CreateImage(0, 256,256)
  
  If StartDrawing(ImageOutput(0))
    
    Box(0, 0, 256,256, $FFFFFF)
    
    DrawingMode(#PB_2DDrawing_Gradient)      
    BackColor($00FFFF)
    FrontColor($FF0000)
    
    LinearGradient(0, 0, 256, 256)    
    Circle(100, 100, 100)   
    LinearGradient(350, 100, 250, 100)
    Circle(300, 100, 100)
    
    StopDrawing() 
    
  EndIf 
  
  SaveImage(0, "Texture.bmp")
  
EndIf 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Now we create the *.zpk file

Debug ZLIB_Version()

If ZLIB_CreatePack("Test.zpk")
  
  ZLIB_AddPackByte(125, 9)
  ZLIB_AddPackAscii(250, 9)
  ZLIB_AddPackCharacter(251, 9)
  ZLIB_AddPackUnicode(65000, 9)
  ZLIB_AddPackWord(-15000, 9)
  ZLIB_AddPackInteger(2147483647, 9)
  ZLIB_AddPackLong(2147483640, 9)
  ZLIB_AddPackQuad(9223372036854775807, 9)
  
  ZLIB_ClosePack()
  
EndIf

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Now we append the *.zpk file

If ZLIB_AppendPack("Test.zpk")
  
  ZLIB_AddPackFloat(2*#PI, 9)
  ZLIB_AddPackDouble(4*#PI, 9)
  ZLIB_AddPackString("PureBasic 4.60 Beta 3", 9)
  ZLIB_AddPackString("Texture2.bmp", 9) ; The file name is different, it's just for the exemple
  ZLIB_AddPackFile("Texture.bmp", 9)
  ZLIB_ClosePack()
  
EndIf

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; And now we open the *.zpk file

If ZLIB_OpenPack("Test.zpk")
  
  Debug ZLIB_UnPackByte()
  Debug ZLIB_UnPackAscii()
  Debug ZLIB_UnPackCharacter()
  Debug ZLIB_UnPackUnicode()
  Debug ZLIB_UnPackWord()
  Debug ZLIB_UnPackInteger()
  Debug ZLIB_UnPackLong()
  Debug ZLIB_UnPackQuad()
  Debug ZLIB_UnPackFloat()
  Debug ZLIB_UnPackDouble()
  Debug ZLIB_UnPackString()
  
  FileName.s = ZLIB_UnPackString()
  File.i = ZLIB_NextPackFile()
  
  If CreateFile(0, FileName)
    WriteData(0, File, MemorySize(File))
    CloseFile(0)  
  EndIf
  
  ZLIB_ClosePack()
  
EndIf

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

PureBasic

Packer Extra Function

Packer Extra Function

Re: Packer Extra Function

Re: Packer Extra Function

Re: Packer Extra Function

Re: Packer Extra Function

Re: Packer Extra Function

Re: Packer Extra Function

Re: Packer Extra Function

Re: Packer Extra Function

Re: Packer Extra Function