2010-12-08 11:05

' 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
 

2010-12-08 11:05