Files
harbour-core/harbour/contrib/xhb/tests/compress.prg
Viktor Szakats 70140e5aed 2012-07-22 23:52 UTC+0200 Viktor Szakats (vszakats syenar.net)
* contrib/hbct/tests/ctwtest.prg
  * contrib/hbcups/tests/test.prg
  * contrib/hbfbird/tests/stress.prg
  * contrib/hbnf/aredit.prg
  * contrib/hbnf/doc/en/aredit.txt
  * contrib/hbnf/menu1.prg
  * contrib/hbnf/popadder.prg
  * contrib/hbnf/tbwhile.prg
  * contrib/hbpgsql/tests/async.prg
  * contrib/hbpgsql/tests/cache.prg
  * contrib/hbpgsql/tests/stress.prg
  * contrib/hbpgsql/tests/test.prg
  * contrib/hbtip/tests/tiptest.prg
  * contrib/xhb/tests/compress.prg
  * doc/en/sayget.txt
  * src/rtl/profiler.prg
  * tests/ac_test.prg
  * tests/boxtst2.prg
  * tests/fortest.prg
  * tests/menutest.prg
  * tests/mt/mttest11.prg
  * tests/parseini.prg
  * tests/speedold.prg
  * tests/tstchbx.prg
  * tests/usrrdd/exarr.prg
  * tests/videotst.prg
  * tests/vidtest.prg
    * formatting
    ! deleted SetMode()s
    * CLEAR SCREEN -> CLS
    * other minor cleanups
2012-07-22 21:54:14 +00:00

73 lines
2.3 KiB
Plaintext

/*
* $Id$
*/
//****************************************************
// Demo of realtime string compression
//
// Giancarlo Niccolai
#include "hbcomprs.ch"
PROCEDURE Main()
LOCAL cText := "A text to be compressed "
LOCAL cComp
LOCAL cDecomp
LOCAL nError, nBufLen
CLS
@ 1, 15 SAY "X H A R B O U R - ZLIB based compression test"
@ 2, 5 SAY "TEST 1: using on-the-fly Buffer creation"
nBufLen := HB_CompressBuflen( Len( cText ) )
//cComp and cDecomp will be created with the correct length
cComp := HB_Compress( cText )
cDecomp := HB_Uncompress( nBuflen, cComp )
@ 3, 7 SAY "Uncompressed: (" + hb_ntos( Len( cText ) ) + ")" + cText + "<<"
@ 4, 7 SAY "Compressed (" + hb_ntos( Len( cComp ) ) + ")" + cComp + "<<"
@ 5, 7 SAY "Decompressed: (" + hb_ntos( Len( cDecomp ) ) + ")" + cDecomp + "<<"
@ 7, 5 SAY "TEST 2: using preallocated buffers"
cComp := Space( nBufLen )
// We allocate more space (manual says 0.1% + 12, but you can never know...)
// to allow compression of uncompressable strings to grow a little.
cDecomp := Space( Int( nBufLen * 1.1 ) )
// on exit, nBuflen will contain the length of the compressed buffer
HB_Compress( cText, Len( cText ), @cComp, @nBuflen )
HB_Uncompress( Len( cText ), cComp, nBuflen , @cDecomp )
@ 8, 7 SAY "Uncompressed: (" + hb_ntos( Len( cText ) ) + ")" + cText + "<<"
@ 9, 7 SAY "Compressed (" + hb_ntos( nBuflen ) + ")" + cComp + "<<"
// Notice: this time the lenght of the destination buffer is not the lenght of
// the original buffer, but Int(nBufLen * 1.1)
@ 10, 7 SAY "Decompressed: (" + hb_ntos( Len( cDecomp ) ) + ")" + cDecomp + "<<"
@ 12, 5 SAY "TEST 3: Generating an error"
nBufLen := HB_CompressBuflen( Len( cText ) )
cComp := Space( nBufLen )
cDecomp := Space( Len( cText ) )
// we generate an error: 3 is not a valid length for this buffer
nBuflen := 3
nError := HB_Compress( cText, Len( cText ), @cComp, @nBuflen )
IF nError != HB_Z_OK
@ 13, 7 SAY "Error generated (" + hb_ntos( Len( cComp ) ) + ")" + ;
HB_CompressErrorDesc( nError )
ELSE
@ 13, 7 SAY "NO Error generated (" + hb_ntos( Len( cComp ) ) + ")" + ;
HB_CompressErrorDesc( nError )
ENDIF
@ 22, 25 SAY "Press a key to terminate"
Inkey( 0 )
RETURN