PB4.xx Speicher packen/entpacken im Zipformat

[ts-soft]

Code: Alles auswählen

; Autor: Thomas (ts-soft) Schulz
; PB-Version: 4.xx
; OS: windows/linux/MacOS

CompilerSelect #PB_Compiler_OS
  CompilerCase #PB_OS_Linux
    ImportC #PB_Compiler_Home + "purelibraries/linux/libraries/zlib.a"
CompilerCase #PB_OS_MacOS
  ImportC "/usr/lib/libz.dylib"
  CompilerCase #PB_OS_Windows
    ImportC "zlib.lib"
CompilerEndSelect
  compress2(*dest, *destLen, *source, sourceLen, level)
  uncompress(*dest, *destLen, *source, sourceLen)
EndImport

Procedure zipPackMemory(*source, sourceLen = #PB_Default, level = #PB_Default)
  Protected *dest, destLen
  
  If level < #PB_Default Or level > 9 : level = #PB_Default : EndIf
  If *source
    If sourceLen = #PB_Default : sourceLen = MemorySize(*source) : EndIf
    destLen = sourceLen + 13 + (Int(sourceLen / 100))
    *dest = AllocateMemory(destLen)
    If *dest
      If Not compress2(*dest, @destLen, *source, sourceLen, level)
        *dest = ReAllocateMemory(*dest, destLen)
        ProcedureReturn *dest
      EndIf
    EndIf
  EndIf
EndProcedure

Procedure zipUnpackMemory(*source, *dest)
  Protected sourceLen = MemorySize(*source)
  Protected destLen = MemorySize(*dest)

  If Not uncompress(*dest, @destLen, *source, sourceLen)
    ProcedureReturn destLen
  EndIf
EndProcedure

; Beispiel:
Define test.s = "Feel the ..Pure.. Power"
Define *Mem = zipPackMemory(@test, StringByteLength(test))

If *Mem
  Define *destMem = AllocateMemory(StringByteLength(test))
  Debug PeekS(*destMem, zipUnpackMemory(*Mem, *destMem))
EndIf

Kann ja vielleicht einer brauchen

// edit
Anpassung an MacOS

[Kiffi]

Danke!

(allerdings solltest Du in Deinem Beispiel einen anderen (längeren)
Teststring nehmen, denn in diesem Fall ist der gepackte Output länger als
die Quelle )

Grüße ... Kiffi

[ts-soft]

(allerdings solltest Du in Deinem Beispiel einen anderen (längeren) Teststring nehmen, denn in diesem Fall ist der gepackte Output länger als die Quelle )

Stimmt ja garnicht, im Unicode-Modus spart man 3 Byte

[Kiffi]

nimm einfach

Code: Alles auswählen

Define test.s = Space(32000)

das ist beeindruckender. Mit oder ohne Unicode

Grüße ... Kiffi

[ts-soft]

nimm einfach

Code: Alles auswählen

Define test.s = Space(32000)

das ist beeindruckender. Mit oder ohne Unicode

Grüße ... Kiffi

Knapp 100 KB hat die zlib.lib, ist also auch noch nicht so beeindruckend

Gruß
Thomas