' Read data from a string/file, then compress it with the free zlib library.
' Files are written as a compressed .gz file or a QmemoryStream
' using QmemoryStream you can compress arrays, UDT, bitmaps, whatever!
' by JohnK , code parts by lucassioli.geo" <cassioli@...

$TYPECHECK ON
DECLARE Function gzCompressFile(inFile As String, outFile As String) As Long
DECLARE Function gzCompressString(inString As String, OutMem AS QMEMORYSTREAM) AS Long
DECLARE Function gzDeCompressFile(inFile As String, outFile As String) As Long
DECLARE Function gzDecompressToString(InMem AS QMEMORYSTREAM) As String

$include "rapidq.inc"
$include "zlib.inc"     'RQ ported include file for windows


''-----------------------------------------------------------------
''  test code to compress / decompress a file
''-----------------------------------------------------------------
'pack junk.txt (or whatever file)
IF gzCompressFile("junk.txt", "junk.txt.gz") = Z_OK THEN
    Showmessage "compression done"
ELSE
    Showmessage "compression error"
    END
END IF

'now test for unpacking
IF gzDeCompressFile("junk.txt.gz", "text_out.txt") = Z_OK THEN
    Showmessage "Decompression done"
END IF



''------------------------------------------------------------
''        test code to compress / decompress memory 
''------------------------------------------------------------

DEFSTR inString = "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz"
DEFSTR outString
DIM myMem AS QMEMORYSTREAM

gzCompressString(inString, myMem)           'myMem has compressed data
inString = ""                               'deallocate
outString = gzDecompressToString(myMem)     'now decompress
Showmessage outString

END





Function gzCompressFile(inFile As String, outFile As String) As Long
    DIM inputfile as qfilestream
    DIM mem as qMemoryStream
    DIM r as Long                   'our result
    Dim gFile As gzFile             'file handle
    Dim Failure As Integer: Failure = False
    
    '- The input must exist
    If FileExists(inFile) <> True Then Failure = True 'input exists?
    If FileExists(outFile) = True Then Failure = True ' output cannot exist
    '- Tell zLib to open the output file
    IF Failure = False THEN
        InputFile.open(inFile,fmOpenRead)
        IF InputFile.Size < 1 THEN Failure = True 
    END IF
    
    'file has data in it, get it all open gzfile
    IF Failure = False THEN
        mem.CopyFrom(InputFile, InputFile.Size) 'get the original data
        InputFile.close                         'now we have all data
        gFile = gzopen(outFile, "wb9")          'highest level compression
        If gFile < Z_OK Then Showmessage "Error: gzopen("+ str$(gFile)  +")" : Failure = True
    END IF
    
    'gzfile is open ok, now store compressed data
    IF Failure = False THEN
        r = gzwrite(gFile, mem.Pointer, mem.size)
        If r <> mem.size Then showmessage "Error: gzwrite ("+ str$(r)  +")" : Failure = True
    END IF
    
    ' clean up close gzfile
    IF Failure = False THEN
        r = gzclose(gFile)
        IF r <> Z_OK Then showmessage "Error: gzclose ("+ str$(r)  +")": Failure = True
    END IF
    'now deallocate dynamic memory
    Mem.Position = 0
    Mem.Size = 0
    Mem.WriteStr(" ", 1)        'bug in QmemoryStream, needs to have byte assigned
    Mem.Close
    IF Failure = True THEN RESULT = -1 ELSE RESULT = Z_OK
END FUNCTION




Function gzDeCompressFile(inFile As String, outFile As String) As Long
    $DEFINE _BLOCK_SIZE   100000    'working value, bigger or smaller as you need
    DIM Blk(_BLOCK_SIZE) As Byte
    DIM inputfile as qfilestream
    DIM mem as qMemoryStream
    DIM r as Long                   'our result
    Dim gFile As gzFile             'file handle
    Dim Failure As Integer: Failure = False
    
    '- The input must exist
    If FileExists(inFile) <> True Then Failure = True 'input exists?
    If FileExists(outFile) = True Then Failure = True ' output cannot exist

    '- Tell zLib to open the input file, it decompresses into memory buffer
    IF Failure = False THEN
        gFile = gzopen(inFile, "rb")
        If gFile < Z_OK Then showmessage "Error: gzopen("+ str$(gFile)  +")" :Failure = True
        mem.Position = 0
        WHILE( gzeof(gFile ) = 0 )
            r = gzread(gFile, VarPtr(Blk(0)), _BLOCK_SIZE )
            IF r = _BLOCK_SIZE THEN
                mem.SaveArray(Blk(0), _BLOCK_SIZE)      'automatic append to end of mem stream
            ELSE
                mem.SaveArray(Blk(0), r)
            END IF
        WEND
    END IF

    'decompressed into memory OK, now close the file 
    IF Failure = False THEN
        r = gzclose(gFile)
        If r <> Z_OK Then showmessage "Error: gzclose ("+ str$(r)  +")" :Failure = True
    END IF

    'Now store the decompressed buffer into a file
    IF Failure = False THEN
        InputFile.open(outFile,fmCReate)
        InputFile.CopyFrom(mem, 0)' whole stream is copied
        InputFile.close
    END IF
    'now deallocate dynamic memory
    Mem.Position = 0
    Mem.Size = 0
    Mem.WriteStr(" ", 1)        'bug in QmemoryStream, needs to have byte assigned
    Mem.Close
    IF Failure = True THEN RESULT = -1 ELSE RESULT = Z_OK
END FUNCTION


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  gzCompressString
'  Compresses the string
'  Code adapted from Don Dickinson PB example, modified for RQ by JohnK
'  ddickinson@usinternet.com
'  store compressed string in Qmemorystream because it might have a zero (early termination)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
Function gzCompressString(inString As String, OutMem AS QMEMORYSTREAM) AS Long
   Dim iReturn As Long
   Dim iDeComp As Long
   Dim iComp As Long
   DEFSTR tmpStr = inString     'need this for string pointer
   DIM tmpMem As QMemoryStream

   RESULT = False              'set in case of failure
   If Len(inString) > 1  Then
      '- Calculate and allocate the compression buffer.
      tmpMem.Size = (Len(tmpStr) * 1.2 + 12)
      iComp = tmpMem.Size       'need a ref pointer here too, MEM.size is set/get
      iDeComp = Len(tmpStr)
      '- Compress it
      iReturn = compress(tmpMem.Pointer, iComp, VarPtr(tmpStr), iDeComp)
      If iReturn = Z_OK Then
         '- the first 4 bytes in compressed stream has the length of the decompressed buffer
         OutMem.Write(iDecomp)          'RQ knows Long takes 4 bytes
         OutMem.CopyFrom(tmpMem, iComp) 'copy remaining buffer
         RESULT = True
      Else
         ShowMessage "Error compressing buffer (" + Str$(iReturn) + ")"
         RESULT =  False
      End If
   End If
End Function


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function gzDecompressToString(InMem AS QMEMORYSTREAM) As String
   Dim iReturn As Long                  'read results
   Dim iDeComp As Long
   Dim deString As String
   Dim SizStr As String

   RESULT = ""                          'set in case of failure   
   If InMem.Size > 4 Then
      '- The first 4 bytes contain the length of the decompressed string
      InMem.Position = 0
      InMem.Read(iDeComp)
      '- Create the decompression buffer, alloc string space
      deString = SPACE$(iDeComp)
      iReturn = uncompress(VarPtr(deString), iDeComp, InMem.Pointer + 4, InMem.Size)
      if iReturn = Z_OK THEN 
            RESULT = deString
      else
            Showmessage "Decompression Failed ("+ Str$(iReturn) + ")"
      end if
   end if
End Function