PureBasic Forums - English

Posted: **Thu May 26, 2011 5:53 am**

Hello everyone,

This is a tiny Packer Extra Function Lib but it bot deserve a Nobel Price. I have created this lib to be able to add some extra info in a Pack file such as Array or Linked List size and the file name along packed file. I hope this lib can be useful for someone else.

Have fun !
Guimauve

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; 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 <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Posted: **Thu May 26, 2011 6:30 am**

nice shot

Posted: **Thu May 26, 2011 7:02 am**

Thanks. But you are using PureBasic packer. Upon this, something that is packed using windows is not to be unpacked using linux (and vice versa). Sadly, but not your fault...

Kukulkan

Posted: **Thu May 26, 2011 8:09 am**

you wrong already tested in LINUX 11.10,
working is nothing wrong with the code,it's good for who know programming.

Posted: **Thu May 26, 2011 8:49 am**

you wrong already tested in LINUX 11.10

It runs fine on Linux, if you decompress on linux, too. But try to compress on Linux and decompress on Windows and you will find out...
http://www.purebasic.fr/english/viewtop ... 13&t=39728
http://www.purebasic.fr/english/viewtop ... =3&t=44577

The code is fine and, as I allready mentioned, the plattform-compatibility issue is not Guimauve's fault.

Kukulkan

Posted: **Thu May 26, 2011 2:32 pm**

Kukulkan wrote:Thanks. But you are using PureBasic packer. Upon this, something that is packed using windows is not to be unpacked using linux (and vice versa). Sadly, but not your fault...

Kukulkan

I have never test this before, it's seem very bad because for one of my project the Packer Lib is used to compress some file on Linux then decompress them on Windows and vice versa. One more bad news ...

Thanks anyway.

Guimauve

Posted: **Wed Jun 01, 2011 4:08 pm**

You can solve that problem by using zlib. Its available on all plattform and included in the PB package. Plus its faster while having a better compression ratio than JCalG1 (default on windows).

Just search the forums for zlib to find out how to use it. If you realy need to decompress JCalG1, i ported the decompressor to x64 and it should work on linux x86 and x64 to, plus my port is faster than the original lib.
Just search for jcalg1 x64 to find the code.

Posted: **Wed Jun 01, 2011 4:23 pm**

You can solve that problem by using zlib

This is what I did. Best solution.

Too bad that PB fails to do this essential feature cross-platform...

Kukulkan

Posted: **Thu Jun 02, 2011 1:10 am**

Thorium wrote:If you realy need to decompress JCalG1, i ported the decompressor to x64 and it should work on linux x86 and x64 to, plus my port is faster than the original lib.
Just search for jcalg1 x64 to find the code.

For my project, I just need to create compressed archives on any platform and then decompress them on any platform (Same or different one). The compression/decompression algorithm used just don't matter as long as it work the same way on any platform. I will check the zlib out, thanks.

Best regards
Guimauve

Posted: **Fri Jul 08, 2011 3:32 am**

Hello everyone,

This the ZLIB version of the Packer Extra Function. Have fun !

Best regards.
Guimauve

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; 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 <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Posted: **Thu Jul 28, 2011 3:13 am**

Hello everyone,

Ok this is a new version with some new command and a CRC32FingerPrint memory test.

Edit : V1.1.1
Bug correction : ZLIB_AddPackFile()

Best regards.
Guimauve

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : ZLIB Pack Command
; File Name : ZLIB Pack Command.pb
; File version: 1.1.1
; Programmation : OK
; Programmed by : Guimauve
; Date : 07-07-2011
; Last Update : 26-10-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, MemorySize(ZLIB_MemoryCompressed))
		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 <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Posted: **Thu Aug 11, 2011 12:00 pm**

Thanks for this.

The sooner the packer lib in PB gets updated to be cross platform the better. Hopefully they will include zlib as an option.

Posted: **Wed Oct 26, 2011 5:11 pm**

Thanks for the code Guimauve but you made a severe mistake.
When using ZLIB_AddPackFile your lib writes the source length of the file into the archive causing ZLIB_NextPackFile to read more data than available. Remember: source size != destination size
Also please use pointers for memory addresses and mind that pointers do not have a type (

"*Source.i") in PB.

Posted: **Wed Oct 26, 2011 5:31 pm**

I will check this out this afternoon.

Edit : Bug corrected

@Forge

*Source.i is exactly the same as *Source because the Integer type (*.i) is the default one and this type has been automatically added by the compiler so it's not an error ! I have released the source code so if you don't like the pointer with a specified type just remove it your self because I will not do it.

Best regards.
Guimauve

Posted: **Wed Oct 26, 2011 6:11 pm**

Hey Guimauve,
thanks for the fix but now you would cause a buffer overflow when decompressing.

PureBasic Forums - English

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

Re: Packer Extra Function

Re: Packer Extra Function

Re: Packer Extra Function

Re: Packer Extra Function

Re: Packer Extra Function