[Résolu] Problème de compression

Micoute · Message par **Micoute** » mer. 28/mai/2014 16:33

Bonjour à tous, j'essaie de remettre à jour ce programme de Guimauve

Le problème c'est que j'ai droit au message "accès mémoire invalide", pourquoi ?

Je vous remercie tous à l'avance

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

UseZipPacker()

*Entree = AllocateMemory(5000)
*Sortie = AllocateMemory(5000)

Procedure AddPackByte(Var.b, Level.b = 6)
  
  Byte.Byte\b = Var
  AddPackMemory(0, *Entree, SizeOf(Byte), "Test.pak")
  
EndProcedure

Procedure AddPackAscii(Var.a, Level.b = 6)
  
  Ascii.Ascii\a = Var
  AddPackMemory(0, *Entree, SizeOf(Ascii), "Test.pak")
  
EndProcedure

Procedure AddPackCharacter(Var.c, Level.b = 6)
  
  Character.Character\c = Var
  AddPackMemory(0, *Entree, SizeOf(Character), "Test.pak")
  
EndProcedure

Procedure AddPackUnicode(Var.u, Level.b = 6)
  
  Unicode.Unicode\u = Var
  AddPackMemory(0, *Entree, SizeOf(Unicode), "Test.pak")
  
EndProcedure

Procedure AddPackWord(Var.w, Level.b = 6)
  
  Word.Word\w = Var
  AddPackMemory(0, *Entree, SizeOf(Word), "Test.pak")
  
EndProcedure

Procedure AddPackInteger(Var.i, Level.b = 6)
  
  Integer.Integer\i = Var
  AddPackMemory(0, *Entree, SizeOf(Integer), "Test.pak")
  
EndProcedure

Procedure AddPackLong(Var.l, Level.b = 6)
  
  Long.Long\l = Var
  AddPackMemory(0, *Entree, SizeOf(Long), "Test.pak")
  
EndProcedure

Procedure AddPackQuad(Var.q, Level.b = 6)
  
  Quad.Quad\q = Var
  AddPackMemory(0, *Entree, SizeOf(Quad), "Test.pak")
  
EndProcedure

Procedure AddPackFloat(Var.f, Level.b = 6)
  
  Float.Float\f = Var
  AddPackMemory(0, *Entree, SizeOf(Float), "Test.pak")
  
EndProcedure

Procedure AddPackDouble(Var.d, Level.b = 6)
  
  Double.Double\d = Var
  AddPackMemory(0, *Entree, SizeOf(Double), "Test.pak")
  
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, *Entree, StringLen, "Test.pak")
  
EndProcedure 

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

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

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

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

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

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

Procedure.i UnPackInteger()
  
  Var.i = NextPackEntry(0)
  
  ProcedureReturn PeekI(Var) 
EndProcedure

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

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

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

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

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

CompilerIf #PB_Compiler_IsMainFile
  Enumeration fichier
    #Fichier
  EndEnumeration
  
  Global.s fichier="Test.pak"
  
  If CreatePack(#Fichier, fichier)
    
    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(#Fichier)
    
  EndIf
  
  If OpenPack(#Fichier, "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(#Fichier)
    
  EndIf
CompilerEndIf  
; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

PAPIPP · Message par **PAPIPP** » mer. 28/mai/2014 22:08

Bonjour Micoute
Voici la ZLIB de Guimauve corrigée pour PB522

Code : Tout sélectionner

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; 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, *CompressedLength, *UnCompressed, UnCompressedLength, Level.l)
  uncompress(*UnCompressed, *UnCompressedLength, *Compressed, 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, 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, *UnCompressed)
 
  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, 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 = 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 = 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 <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

A+

Micoute · Message par **Micoute** » jeu. 29/mai/2014 9:20

Merci beaucoup PAPIPP, mais qu'est-ce que j'aurais aimé le faire moi-même !

PureBasic

[Résolu] Problème de compression

[Résolu] Problème de compression

Re: Problème de compression

Re: Problème de compression