PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Packer Extra Function

https://www.purebasic.fr/english/viewtopic.php?t=46469

Page 2 of 2

Re: Packer Extra Function

Posted: Wed Oct 26, 2011 6:51 pm
by Guimauve
What is your system Windows, Linux, MacOS ? 32, 64 bits ?

Because here on Linux Mint 11 x64 with PB 4.60RC2 x64, everything just work fine.

Best regards
Guimauve

Re: Packer Extra Function

Posted: Wed Oct 26, 2011 7:16 pm
by X0r
I did not test it, just took a look at your code.

Re: Packer Extra Function

Posted: Sun Feb 19, 2012 9:30 pm
by skywalk
Hi Guimauve,
I still have an error when unpacking your example.
It successfully unpacks the simple integer and long and string stuff, but unpacking Texture2.bmp creates a compressed or corrupted bitmap?

Re: Packer Extra Function

Posted: Mon Feb 20, 2012 1:15 am
by Guimauve
skywalk wrote:Hi Guimauve,
I still have an error when unpacking your example.
It successfully unpacks the simple integer and long and string stuff, but unpacking Texture2.bmp creates a compressed or corrupted bitmap?
I will take a look to this code. Maybe tomorrow I will release new code or corrected version.

Best regards
Guimauve

Re: Packer Extra Function

Posted: Mon Feb 20, 2012 5:37 am
by Guimauve
Hello everyone,

After a complete Re-write of the ZLIB Pack Library, this is the version 2.0.0. I have only tested this lib on Linux Mint 12 x64 + Gnome-Shell and PureBasic 4.61 x64 Beta 1. Everything work as expected including File packing / unpacking (bmp file tested, both files open correctly with "The GIMP" image editing program). But feel free to test and report any problem.

Edit V2.0.1 :
  • Little glich correction in ZLIB_AddpackString() --> PokeW() replaced by PokeU()
  • Little glich correction in ZLIB_UnpackString() --> PeekW() replaced by PeekU()
  • ZLIB_Version() command added
  • Exemple use the Append Pack file function
Edit V2.0.2 :
  • Optimization by Wilbert about Pack String added
Edit V2.0.3 :
  • Bug correction by skywalk about ZLIB_Version(), ZLIB_AddPackFile() and ZLIB_NextPackFile()
Edit V2.0.4
  • Patch to avoid the use of compressbound() function (Bugged in version 1.2.3 of the zlib)
Edit V2.0.5
  • Correction in the ZLIB_CompressBound_Patch() calculation
Edit V2.0.6
  • Correction in the ZLIB_AddPackFile(), a memory leak problem
Best regards
Guimauve

Code: Select all

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

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

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< 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 Last Error Command <<<<<

Procedure.b ZLIB_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 > 0 ; Check for 0 length files
      
      *File_To_Pack_Memory.i = AllocateMemory(File_To_Pack_Length)
      
      If *File_To_Pack_Memory <> #Null
        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)
        FreeMemory(*File_To_Pack_Memory)
      Else
        ZLIB_LAST_ERROR = #ZLIB_MEM_ERROR
      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 > 0 ; 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 somewhere.

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 V" + ZLIB_Version()
Debug ""

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

Re: Packer Extra Function

Posted: Mon Feb 20, 2012 6:28 am
by skywalk
Thanks Guimauve. 8)
Works for me now on Windows.
Checked unicode characters in .txt file and .png files and appending to one .zpk.

Re: Packer Extra Function

Posted: Mon Feb 20, 2012 10:29 am
by jamirokwai
Hi Guimauve,

tested on Mac OS X 10.7.3 with PB 4.6.1, and the example works great!

Cheers,
J.

Re: Packer Extra Function

Posted: Mon Feb 20, 2012 1:00 pm
by Guimauve
Hello everyone,

It's good to see everything running smoothly. I have updated the lib to V2.0.1 see my previous message.

By the way, the version we have in Purebasic indicate we use the V1.2.3 of ZLIB but at ZLIB dot net indicate the V1.2.6 released 3 weeks ago. Maybe it's time to upgrade the zlib to newer version.

Best regards.
Guimauve

Re: Packer Extra Function

Posted: Mon Feb 20, 2012 2:28 pm
by wilbert
@Guimauve, if you would like a shorter code for strings, you could do it like this

Code: Select all

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

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

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

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

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

Re: Packer Extra Function

Posted: Mon Feb 20, 2012 3:04 pm
by Guimauve
wilbert wrote:@Guimauve, if you would like a shorter code for strings, you could do it like this
Code updated

Best regards
Guimauve

Re: Packer Extra Function

Posted: Mon Feb 20, 2012 5:26 pm
by skywalk
Hi Guimauve,
Small bug fixes...

Code: Select all

; Prevent fail if compiled with unicode
Procedure.s ZLIB_Version()
  VersionBuffer.i = zlibVersion()
  If VersionBuffer <> #Null
    Version.s = Space(32)
    Version = PeekS(VersionBuffer,32,#PB_Ascii) ; If #PB_COMPILER_UNICODE = 1
    ZLIB_LAST_ERROR = #ZLIB_OK
  Else
    Version = ""
    ZLIB_LAST_ERROR = #ZLIB_VERSION_ERROR
  EndIf
  ProcedureReturn Version
EndProcedure 

; Prevent fail on 0 length files
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 

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

Re: Packer Extra Function

Posted: Mon Feb 20, 2012 7:25 pm
by Guimauve
@skywalk

Code updated.

Best regards
Guimauve
All times are UTC+01:00
Page 2 of 2

Powered by phpBB® Forum Software © phpBB Limited