Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

String compressor/decompressor

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • String compressor/decompressor

    I had to write a simple string compressor/decompressor for a database project that allows variable length records.
    This is for user-input TEXT strings only, as the ASCII code 0 is being used arbitrarily as a "marker" for blocks
    of duplicate characters that are compressed. Can anyone see where it could be made faster? (Please respond in the
    Programming forum) Thanks.
    Code:
    #COMPILE EXE
    #REGISTER NONE
    #INCLUDE "Win32Api.Inc"
    
    
    GLOBAL BlockChar AS STRING
    
    
    FUNCTION Compress(Source AS STRING) AS STRING
       LOCAL LoopVar    AS LONG
       LOCAL Compressed AS STRING
       LOCAL CurrChar   AS STRING
       LOCAL CharCount  AS LONG
       IF INSTR(Source, BlockChar) THEN
          EXIT FUNCTION
       ELSE
          CurrChar = MID$(Source, 1, 1)
          CharCount = 1
          FOR LoopVar = 2 TO LEN(Source) + 1
             IF MID$(Source, LoopVar, 1) <> CurrChar OR CharCount = 255 OR LoopVar = LEN(Source) + 1 THEN
                IF CharCount > 1 THEN
                   IF CharCount > 3 THEN
                      Compressed = Compressed + BlockChar + CHR$(CharCount) + CurrChar
                   ELSE
                      Compressed = Compressed + STRING$(CharCount, CurrChar)
                   END IF
                   CharCount = 1
                ELSE
                   Compressed = Compressed + CurrChar
                END IF
                CurrChar = MID$(Source, LoopVar, 1)
             ELSE
                INCR CharCount
             END IF
          NEXT
       END IF
       FUNCTION = Compressed
    END FUNCTION
    
    
    FUNCTION Decompress(Source AS STRING) AS STRING
       LOCAL Decompressed AS STRING
       LOCAL PrevSeekPos  AS LONG
       LOCAL SeekPos      AS LONG
       PrevSeekPos = 1
       DO
          SeekPos = INSTR(SeekPos + 1, Source, BlockChar)
          IF SeekPos THEN
             Decompressed = Decompressed + MID$(Source, PrevSeekPos, SeekPos - PrevSeekPos)
             Decompressed = Decompressed + STRING$(ASC(MID$(Source, SeekPos + 1)), MID$(Source, SeekPos + 2))
             PrevSeekPos = SeekPos + 3
          ELSE
             Decompressed = Decompressed + MID$(Source, PrevSeekPos, LEN(Source) - (PrevSeekPos - 1))
             EXIT DO
          END IF
       LOOP
       FUNCTION = Decompressed
    END FUNCTION
    
    
    FUNCTION PBMAIN
       LOCAL A AS STRING
       LOCAL B AS STRING
       LOCAL C AS STRING
       LOCAL Start   AS DWORD
       LOCAL Finish  AS DWORD
    
    
       BlockChar = CHR$(0) ' <--- Can be any ASCII code not likely to be in a text string (eg: 255)
    
    
       ' 64K test string
       A = "Sample " + STRING$(21835, "X") + " Text " + STRING$(21835, "Z") + " Compressor " + SPACE$(21835) + " ABCDE"
    
    
       Start = GetTickCount
       B = Compress(A)
       IF LEN(B) THEN
          C = Decompress(B)
          Finish = GetTickCount
          IF C = A THEN
             MSGBOX "Return string  (" + TRIM$(STR$(LEN(C))) + " bytes)  matches the source string!" + $CRLF + $CRLF +_
                    "Compressed  AND  Decompressed  in  " + FORMAT$((Finish - Start) / 1000, "#.###") + "  seconds."
          ELSE
             MSGBOX "Oops!  Return string did NOT match source string!"
          END IF
       ELSE
          MSGBOX "Source string was binary (contained a NULL ASCII character)" + $CRLF + $CRLF +_
                 "This routine is for text strings!"
       END IF
    END FUNCTION
    [This message has been edited by Timm Motl (edited March 01, 2001).]
    mailto:[email protected]
    Tsunami Record Manager

  • #2
    Previously posted example worked well on strings that contain long runs of duplicate characters to
    compress, but ran terribly slow on strings that have few or no runs of duplicate characters (like
    the test string used below). Decompression was fine, but had to revise the compression code to
    run just as fast (even a little faster) when the string has nothing in it to compress.
    Code:
    #COMPILE EXE
    #REGISTER NONE
    #INCLUDE "Win32Api.Inc"
    
    
    GLOBAL BlockChar AS STRING
    
    
    FUNCTION Compress(Source AS STRING) AS STRING
       LOCAL CharCount  AS LONG
       LOCAL Compressed AS STRING
       LOCAL CurrChar   AS STRING
       LOCAL Loop1      AS LONG
       LOCAL Loop2      AS LONG
       LOCAL Mark1      AS LONG
       LOCAL Mark2      AS LONG
       IF INSTR(Source, BlockChar) THEN
          EXIT FUNCTION
       ELSE
          CurrChar = MID$(Source, 1, 1)
          CharCount = 1
          Mark1 = 1      
          FOR Loop1 = 2 TO LEN(Source) + 1
             IF MID$(Source, Loop1, 1) <> CurrChar OR CharCount = 255 OR Loop1 = LEN(Source) + 1 THEN
                IF CharCount > 1 THEN
                   IF CharCount > 3 THEN
                      IF Mark2 THEN            
                         Compressed = Compressed + MID$(Source, Mark1, Mark2)
                         Mark2 = 0
                      END IF                 
                      Compressed = Compressed + BlockChar + CHR$(CharCount) + CurrChar
                      Mark1 = Loop1 
                      CharCount = 1
                   ELSE      
                      FOR Loop2 = 1 TO CharCount
                         INCR Mark2
                      NEXT
                   END IF          
                   CharCount = 1
                ELSE
                   INCR Mark2
                END IF
                CurrChar = MID$(Source, Loop1, 1)
             ELSE     
                INCR CharCount
             END IF
          NEXT
          IF Mark2 THEN            
             Compressed = Compressed + MID$(Source, Mark1, Mark2)
          END IF                 
       END IF
       FUNCTION = Compressed
    END FUNCTION
    
    
    FUNCTION Decompress(Source AS STRING) AS STRING
       LOCAL Decompressed AS STRING
       LOCAL PrevSeekPos  AS LONG
       LOCAL SeekPos      AS LONG
       PrevSeekPos = 1
       DO
          SeekPos = INSTR(SeekPos + 1, Source, BlockChar)
          IF SeekPos THEN
             Decompressed = Decompressed + MID$(Source, PrevSeekPos, SeekPos - PrevSeekPos)
             Decompressed = Decompressed + STRING$(ASC(MID$(Source, SeekPos + 1)), MID$(Source, SeekPos + 2))
             PrevSeekPos = SeekPos + 3
          ELSE
             Decompressed = Decompressed + MID$(Source, PrevSeekPos, LEN(Source) - (PrevSeekPos - 1))
             EXIT DO
          END IF
       LOOP
       FUNCTION = Decompressed
    END FUNCTION
    
    
    FUNCTION PBMAIN
       LOCAL A AS STRING
       LOCAL B AS STRING
       LOCAL C AS STRING
       LOCAL Start   AS DWORD
       LOCAL Finish  AS DWORD
    
    
       BlockChar = CHR$(0) ' <--- Can be any ASCII code not likely to be in a text string (eg: 255)
    
    
       ' 64K test string
       ' A = "Sample " + STRING$(21835, "X") + " Text " + STRING$(21835, "Z") + " Compressor " + SPACE$(21835) + " ABCDE"
       A = REPEAT$(2520, "ABCDEFGHIJKLMNOPQRSTUVWXYZ") + "ABCDEFGHIJKLMNOP"
    
    
       Start = GetTickCount
       B = Compress(A)
       IF LEN(B) THEN
          C = Decompress(B)
          Finish = GetTickCount
          IF C = A THEN
             MSGBOX "Return string  (" + TRIM$(STR$(LEN(C))) + " bytes)  matches the source string!" + $CRLF + $CRLF +_
                    "Compressed  AND  Decompressed  in  " + FORMAT$((Finish - Start) / 1000, "#.###") + "  seconds."
          ELSE
             MSGBOX "Oops!  Return string did NOT match source string!"
          END IF
       ELSE
          MSGBOX "Source string was binary (contained a NULL ASCII character)" + $CRLF + $CRLF +_
                 "This routine is for text strings!"
       END IF
    END FUNCTION
    Timm
    mailto:[email protected]
    Tsunami Record Manager

    Comment


    • #3
      This would be much faster if you used byte pointers.


      ------------------
      Calvin Chipman
      PowerBASIC Staff
      Calvin Chipman
      PowerBASIC Staff

      Comment


      • #4
        Calvin:

        I tried pointers too... didn't notice any speed difference. Can you try revising the above code to
        gain some speed improvement and post it? Maybe I'm just missing something.

        Timm
        mailto:[email protected]
        Tsunami Record Manager

        Comment


        • #5
          No, I don't have time to rewrite your code, but I can show you
          some code to point you in the right direction. What you want to
          do is use pointers to step through the entire string one and only
          once. By using InStr you are stepping through the string each
          time you use it. Also when you concatenate strings, using pointers
          is much faster because you are adding to the string directly,
          rather than having other code doing the stepping for you.

          The following code shows how to use pointers to step through
          one string and copy all but white space characters to another
          string:

          '------------------------------------------------------------------------------
          Function GetAllExceptWhiteSpace(sSource As String) As String

          Dim sDestination As String
          Dim pSrc As Byte Ptr
          Dim pDst As Byte Ptr

          'Initialize the destination string to the same size as the source.
          sDestination = Space$(Len(sSource))

          pSrc = StrPtr(sSource)
          pDst = StrPtr(sDestination)

          Do While @pSrc
          Select Case @pSrc
          Case 9, 10, 13, 32
          'Skip white space characters
          '(Tab, Line Feed, Carriage Return, Space).
          Case Else
          @pDst = @pSrc
          Incr pDst
          End Select
          Incr pSrc
          Loop

          'Return only the newly copied part.
          Function = Left$(sDestination, pDst - StrPtr(sDestination))

          End Function
          '------------------------------------------------------------------------------




          ------------------
          Calvin Chipman
          PowerBASIC Staff
          Calvin Chipman
          PowerBASIC Staff

          Comment


          • #6
            Sorry, I'm new at posting stuff. Here's another try:

            Code:
            '------------------------------------------------------------------------------
            Function GetAllExceptWhiteSpace(sSource As String) As String
            
                Dim sDestination As String
                Dim pSrc As Byte Ptr
                Dim pDst As Byte Ptr
            
                'Initialize the destination string to the same size as the source.
                sDestination = Space$(Len(sSource))
            
                pSrc = StrPtr(sSource)
                pDst = StrPtr(sDestination)
            
                Do While @pSrc
                    Select Case @pSrc
                        Case 9, 10, 13, 32
                            'Skip white space characters
                            '(Tab, Line Feed, Carriage Return, Space).
                        Case Else
                            @pDst = @pSrc
                            Incr pDst
                    End Select
                    Incr pSrc
                Loop
            
                'Return only the newly copied part.
                Function = Left$(sDestination, pDst - StrPtr(sDestination))
            
            End Function
            '------------------------------------------------------------------------------
            ------------------
            Calvin Chipman
            PowerBASIC Staff
            Calvin Chipman
            PowerBASIC Staff

            Comment


            • #7
              Calvin:

              Thanks for the code example. When I previously tried pointers, I wasn't using them nearly to the extent that I could/should
              have been. Your help gave me the direction I needed to really exploit pointers in this routine... gained an average 10x speed
              improvement. Who knows... maybe it can be tweaked even further. Thanks again for the response.
              Code:
              #COMPILE EXE
              #REGISTER ALL
              #INCLUDE "Win32Api.Inc"
              
              
              FUNCTION Compress(Source AS STRING) AS STRING
                 LOCAL CharCount   AS LONG
                 LOCAL Loop1       AS LONG
                 LOCAL Loop2       AS LONG
                 LOCAL SourceLen   AS LONG
                 LOCAL BlockChar   AS STRING
                 LOCAL Compressed  AS STRING      
                 LOCAL CurrChar    AS STRING
                 LOCAL DupChar     AS STRING
                 LOCAL pBlockChar  AS BYTE PTR
                 LOCAL pCompressed AS BYTE PTR
                 LOCAL pCurrChar   AS BYTE PTR
                 LOCAL pDupChar    AS BYTE PTR
                 LOCAL pSource     AS BYTE PTR
              
              
                 BlockChar   = CHR$(0)
                 Compressed  = SPACE$(LEN(Source))
                 CurrChar    = " "
                 DupChar     = " "
                 pBlockChar  = STRPTR(BlockChar)     
                 pCompressed = STRPTR(Compressed)
                 pCurrChar   = STRPTR(CurrChar)
                 pDupChar    = STRPTR(DupChar)
                 pSource     = STRPTR(Source)
              
                  
                 IF INSTR(Source, BlockChar) THEN
                    EXIT FUNCTION
                 ELSE
                    @pCurrChar = @pSource
                    INCR pSource
                    CharCount = 1
                    SourceLen = LEN(Source) + 1
                    FOR Loop1 = 2 TO SourceLen
                       IF @pSource <> @pCurrChar OR CharCount = 255 OR Loop1 = SourceLen THEN
                          IF CharCount > 1 THEN
                             IF CharCount > 3 THEN
                                @pCompressed = @pBlockChar
                                INCR pCompressed
                                LSET DupChar = CHR$(CharCount)
                                @pCompressed = @pDupChar
                                INCR pCompressed
                                @pCompressed = @pCurrChar
                                INCR pCompressed
                             ELSE                                                     
                                FOR Loop2 = 1 TO CharCount
                                   @pCompressed = @pCurrChar
                                   INCR pCompressed
                                NEXT
                             END IF
                             CharCount = 1
                          ELSE
                             @pCompressed = @pCurrChar 
                             INCR pCompressed
                          END IF
                          @pCurrChar = @pSource 
                       ELSE
                          INCR CharCount
                       END IF
                       INCR pSource
                    NEXT
                 END IF
                 FUNCTION = LEFT$(Compressed, pCompressed - STRPTR(Compressed))
              END FUNCTION
              
              
              FUNCTION Decompress(Source AS STRING) AS STRING
                 LOCAL PrevSeekPos  AS LONG
                 LOCAL SeekPos      AS LONG   
                 LOCAL BlockChar    AS STRING
                 LOCAL Decompressed AS STRING
                 BlockChar = CHR$(0)                                          
                 PrevSeekPos = 1
                 DO
                    SeekPos = INSTR(SeekPos + 1, Source, BlockChar)
                    IF SeekPos THEN
                       Decompressed = Decompressed + MID$(Source, PrevSeekPos, SeekPos - PrevSeekPos)
                       Decompressed = Decompressed + STRING$(ASC(MID$(Source, SeekPos + 1)), MID$(Source, SeekPos + 2))
                       PrevSeekPos = SeekPos + 3
                    ELSE
                       Decompressed = Decompressed + MID$(Source, PrevSeekPos, LEN(Source) - (PrevSeekPos - 1))
                       EXIT DO
                    END IF
                 LOOP
                 FUNCTION = Decompressed
              END FUNCTION
              
              
              FUNCTION PBMAIN
                 LOCAL A AS STRING
                 LOCAL B AS STRING
                 LOCAL C AS STRING
                 LOCAL Start  AS DWORD
                 LOCAL Finish AS DWORD
              
              
                 ' Two different 64K test strings...
                 ' A = "Sample " + STRING$(21835, "X") + " Text " + STRING$(21835, "Z") + " Compressor " + SPACE$(21835) + " ABCDE"
                 A = REPEAT$(2520, "ABCDEFGHIJKLMNOPQRSTUVWXYZ") + "ABCDEFGHIJKLMNOP"
              
              
                 Start = GetTickCount
                 B = Compress(A)
                 IF LEN(B) THEN      
                    C = Decompress(B)
                    Finish = GetTickCount
                    IF C = A THEN
                       MSGBOX "Return string  (" + TRIM$(STR$(LEN(C))) + " bytes)  matches the source string!" + $CRLF + $CRLF +_
                              "Compressed  AND  Decompressed  in  " + FORMAT$((Finish - Start) / 1000, "#.###") + "  seconds."
                    ELSE
                       MSGBOX "Oops!  Return string did NOT match source string!"
                    END IF
                 ELSE
                    MSGBOX "Source string was binary (contained a NULL ASCII character)" + $CRLF + $CRLF +_
                           "This routine is for text strings!"
                 END IF
              END FUNCTION
              Timm



              [This message has been edited by Timm Motl (edited March 10, 2001).]
              mailto:[email protected]
              Tsunami Record Manager

              Comment


              • #8
                I think these routines are now about fast as I can get them. After compressing the source string,
                I'm adding a four byte DWORD to the front of the compressed string to let the Decompress routine
                know exactly how long the original string was so I can use byte pointers during the decompression.

                On my PIII-800, this will compress and decompress a 64K string in < 5 milliseconds. I'm more than
                happy with that. Thanks again to Calvin for helping me out on this.
                Code:
                #COMPILE EXE
                #REGISTER ALL
                #INCLUDE "WIN32API.INC"
                
                
                FUNCTION Compress(Source AS STRING) AS STRING
                   LOCAL CharCount   AS LONG
                   LOCAL Loop1       AS LONG
                   LOCAL Loop2       AS LONG
                   LOCAL SourceLen   AS LONG
                   LOCAL BlockChar   AS STRING
                   LOCAL Compressed  AS STRING      
                   LOCAL CurrChar    AS STRING
                   LOCAL DupChar     AS STRING
                   LOCAL pBlockChar  AS BYTE PTR
                   LOCAL pCurrChar   AS BYTE PTR
                   LOCAL pCompressed AS BYTE PTR
                   LOCAL pDupChar    AS BYTE PTR
                   LOCAL pSource     AS BYTE PTR
                
                   
                   BlockChar   = CHR$(0)
                   Compressed  = SPACE$(LEN(Source))
                   CurrChar    = " "
                   DupChar     = " "
                   pBlockChar  = STRPTR(BlockChar)     
                   pCompressed = STRPTR(Compressed)
                   pCurrChar   = STRPTR(CurrChar)
                   pDupChar    = STRPTR(DupChar)
                   pSource     = STRPTR(Source)
                
                    
                   IF INSTR(Source, BlockChar) THEN
                      EXIT FUNCTION
                   ELSE
                      @pCurrChar = @pSource
                      INCR pSource
                      INCR CharCount
                      SourceLen = LEN(Source) + 1
                      FOR Loop1 = 2 TO SourceLen
                         IF @pSource <> @pCurrChar OR CharCount = 255 OR Loop1 = SourceLen THEN
                            IF CharCount > 1 THEN
                               IF CharCount > 3 THEN
                                  @pCompressed = @pBlockChar
                                  INCR pCompressed
                                  LSET DupChar = CHR$(CharCount)
                                  @pCompressed = @pDupChar
                                  INCR pCompressed
                                  @pCompressed = @pCurrChar
                                  INCR pCompressed
                               ELSE                                                     
                                  FOR Loop2 = 1 TO CharCount
                                     @pCompressed = @pCurrChar
                                     INCR pCompressed
                                  NEXT
                               END IF
                               CharCount = 1
                            ELSE
                               @pCompressed = @pCurrChar 
                               INCR pCompressed
                            END IF
                            @pCurrChar = @pSource 
                         ELSE
                            INCR CharCount
                         END IF
                         INCR pSource
                      NEXT
                   END IF
                   FUNCTION = MKDWD$(LEN(Source)) + LEFT$(Compressed, pCompressed - STRPTR(Compressed))
                END FUNCTION
                
                
                FUNCTION Decompress(Source AS STRING) AS STRING
                   LOCAL Loop1         AS LONG
                   LOCAL Loop2         AS LONG
                   LOCAL SourceLen     AS LONG
                   LOCAL BlockChar     AS STRING
                   LOCAL DupChar       AS STRING
                   LOCAL Decompressed  AS STRING
                   LOCAL pBlockChar    AS BYTE PTR
                   LOCAL pDecompressed AS BYTE PTR
                   LOCAL pDupChar      AS BYTE PTR
                   LOCAL pSource       AS BYTE PTR
                
                
                   SourceLen     = LEN(Source)
                   BlockChar     = CHR$(0)
                   Decompressed  = SPACE$(CVDWD(Source))
                   pBlockChar    = STRPTR(BlockChar)     
                   pDecompressed = STRPTR(Decompressed)
                   pDupChar      = STRPTR(DupChar)
                   pSource       = STRPTR(Source) + 4
                
                
                   DO
                      IF @pSource = @pBlockChar THEN
                         INCR pSource
                         @pDupChar = @pSource
                         INCR pSource
                         FOR Loop2 = 1 TO @pDupChar
                            @pDecompressed = @pSource
                            INCR pDecompressed
                         NEXT
                      ELSE
                         @pDecompressed = @pSource
                         INCR pDecompressed
                      END IF
                      INCR pSource
                   LOOP WHILE pSource - STRPTR(Source) < SourceLen
                   FUNCTION = Decompressed
                END FUNCTION
                
                
                FUNCTION PBMAIN
                   LOCAL A AS STRING
                   LOCAL B AS STRING
                   LOCAL C AS STRING
                   LOCAL Start  AS DWORD
                   LOCAL Finish AS DWORD
                
                
                   ' 64K test string... highly compressible
                   A = "Sample " + STRING$(21835, "X") + " Text " + STRING$(21835, "Z") + " Compressor " + SPACE$(21835) + " ABCDE"
                
                   
                   ' 64K test string... not compressible
                   'A = REPEAT$(2520, "ABCDEFGHIJKLMNOPQRSTUVWXYZ") + "ABCDEFGHIJKLMNOP"
                
                
                   Start = GetTickCount
                   B = Compress(A)
                   IF LEN(B) THEN
                      C = Decompress(B)
                      Finish = GetTickCount     
                      IF A = C THEN
                         MSGBOX "Compressed and decompressed in  " + _
                                FORMAT$((Finish - Start) / 1000, "#.###") + "  seconds"
                      ELSE
                         MSGBOX "Oops!  Return string did NOT match source string!"
                      END IF
                   ELSE
                      MSGBOX "Source string was binary (contained a NULL ASCII character)" + $CRLF + $CRLF + _
                             "This routine is for text strings only!"
                   END IF
                END FUNCTION
                Timm
                mailto:[email protected]
                Tsunami Record Manager

                Comment


                • #9
                  The string will compress to 211 bytes with zlib.
                  Reference https://forum.powerbasic.com/forum/u...rapper?t=23037
                  Code:
                  FUNCTION PBMAIN () AS LONG
                    LOCAL a,b,c,sErrorCode AS STRING
                  
                    ' 64K test string... not compressible  (using
                    A = REPEAT$(2520, "ABCDEFGHIJKLMNOPQRSTUVWXYZ") + "ABCDEFGHIJKLMNOP"
                  
                    gzCompressString(a, b)
                    gzDeCompressString(b,c)
                    IF a = c THEN sErrorCode = "Success" ELSE sErrorCode = "Failed"
                    ? USING$("Original=#, Compressed=#, Decompressed=#,",LEN(a),LEN(b),LEN(c)),,sErrorCode
                  END FUNCTION
                  '
                  '  pb_zlib.inc
                  '
                  '  Declares and Wrappers for PB-DLL and PB-CC 32-bit
                  '  using zlib32.dll compression library. This is not a
                  '  full translation of the zlib api, but it is enough
                  '  to perform some basic compression/decompression of
                  '  strings and files.
                  '
                  '  By Don Dickinson
                  '  [email protected]
                  '  dickinson.basicguru.com
                  '
                  '  Hereby Public Domain. Provided in good faith by the auther
                  '  Don Dickinson. Your use or mis-use of this code impies that
                  '  you hold the author harmless of all effects and side-effects
                  '  of its use.
                  '
                  '
                  '- These might be defined already, but if not,
                  '  I do it here.
                  '
                  #IF NOT %DEF(%True)
                  %True = -1
                  %False = 0
                  #ENDIF
                  
                  GLOBAL g_gzLastError AS STRING
                  %DECOMPRESS_BLOCK_SIZE     = 100000
                  
                  $Z_OPEN_READ               = "rb"
                  $Z_OPEN_WRITE              = "wb"
                  
                  %Z_NO_FLUSH                = 0
                  %Z_PARTIAL_FLUSH           = 1
                  %Z_SYNC_FLUSH              = 2
                  %Z_FULL_FLUSH              = 3
                  %Z_FINISH                  = 4
                  
                  %Z_OK                      = 0
                  %Z_STREAM_END              = 1
                  %Z_NEED_DICT               = 2
                  %Z_ERRNO                   = -1
                  %Z_STREAM_ERROR            = -2
                  %Z_DATA_ERROR              = -3
                  %Z_MEM_ERROR               = -4
                  %Z_BUF_ERROR               = -5
                  %Z_VERSION_ERROR           = -6
                  
                  %Z_NO_COMPRESSION          = 0
                  %Z_BEST_SPEED              = 1
                  %Z_BEST_COMPRESSION        = 9
                  %Z_DEFAULT_COMPRESSION     = -1
                  
                  %Z_FILTERED                = 1
                  %Z_HUFFMAN_ONLY            = 2
                  %Z_DEFAULT_STRATEGY        = 0
                  
                  %Z_BINARY                  = 0
                  %Z_ASCII                   = 1
                  %Z_UNKNOWN                 = 2
                  
                  %Z_DEFLATED                = 8
                  
                  DECLARE FUNCTION compress LIB "zlib.dll" ALIAS "compress" _
                          (   compr AS ANY, comprLen AS LONG, buf AS ANY, _
                              BYVAL buflen AS LONG ) AS LONG
                  
                  DECLARE FUNCTION uncompress LIB "zlib.dll" ALIAS "uncompress" _
                          (   uncompr AS ANY, uncomprLen AS LONG, compr AS ANY, _
                              BYVAL lcompr AS LONG ) AS LONG
                  
                  DECLARE FUNCTION gzopen LIB "zlib.dll" ALIAS "gzopen" _
                          (   zFile AS ASCIIZ, zMode AS ASCIIZ ) AS LONG
                  
                  DECLARE FUNCTION gzread LIB "zlib.dll" ALIAS "gzread" _
                          (   BYVAL file AS LONG, uncompr AS ANY, _
                              BYVAL uncomprLen AS LONG ) AS LONG
                  
                  DECLARE FUNCTION gzwrite LIB "zlib.dll" ALIAS "gzwrite" _
                          (   BYVAL file AS LONG, uncompr AS ANY, _
                              BYVAL uncomprLen AS LONG) AS LONG
                  
                  DECLARE FUNCTION gzclose LIB "zlib.dll" ALIAS "gzclose" _
                          (   BYVAL file AS LONG ) AS LONG
                  
                  '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                  '  gzGetLastError
                  '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                  FUNCTION gzGetLastError() AS STRING
                     FUNCTION = g_gzLastError
                  END FUNCTION
                  
                  '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                  '  gzCompressFile
                  '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                  FUNCTION gzCompressFile(inFile AS STRING, outFile AS STRING) AS LONG
                  
                     DIM hInput AS LONG
                     DIM hOutput AS LONG
                     DIM iReturn AS LONG
                     DIM i AS LONG
                     DIM iBlocks AS LONG
                     DIM iLeft AS LONG
                     DIM sInput AS STRING
                  
                     '- Initialize the error message
                     g_gzLastError = "Success"
                  
                     '- The input must exist
                     IF DIR$(inFile) = "" THEN
                        g_gzLastError = "Input file " + inFile + " not found"
                        GOTO gzCompresssFile_Error
                     END IF
                  
                     '- The output cannot exist
                     IF DIR$(outFile) <> "" THEN
                        g_gzLastError = "Output file: " + outFile + " already exists"
                        GOTO gzCompresssFile_Error
                     END IF
                  
                     '- Tell zLib to open the output file
                     hOutput = gzopen(BYCOPY outFile, $Z_OPEN_WRITE)
                     IF hOutput = 0 THEN
                        g_gzLastError = "zLib is unable to open output file: " + outFile
                        GOTO gzCompresssFile_Error
                     END IF
                  
                     '- Use PB to open the input file
                     ON ERROR RESUME NEXT
                     hInput = FREEFILE
                     OPEN inFile FOR BINARY SHARED AS #hInput
                     IF ERR THEN
                        hInput = 0
                        g_gzLastError = "Unable to open input file: " + inFile + " Error =" + STR$(ERR)
                        GOTO gzCompresssFile_Error
                     ELSEIF LOF(hInput) < 1 THEN
                        g_gzLastError = "Input file: " + inFile + " is zero-length"
                        GOTO gzCompresssFile_Error
                     END IF
                  
                     #IF 0
                     '- Get memory for the input buffer
                     ON ERROR RESUME NEXT
                     sInput = STRING$(LOF(hInput), 0)
                     IF ERR THEN
                        g_gzLastError = "Error allocating " + FORMAT$(LOF(hInput)) + " bytes of memory"
                        GOTO gzCompresssFile_Error
                     END IF
                  
                     '- Fill the decompression (input) buffer with the contents
                     '  of the input file.
                     '
                     GET #hInput,, sInput
                     IF ERR THEN
                        g_gzLastError = "Error reading from: " + inFile + " Error =" + STR$(ERR)
                        GOTO gzCompresssFile_Error
                     END IF
                  
                     '- Compress the data to the output file
                     iReturn = gzwrite(hOutput, BYVAL STRPTR(sInput), LEN(sInput))
                     IF iReturn <> LEN(sInput) THEN
                        g_gzLastError= "Error compressing data buffer: " + FORMAT$(iReturn)
                        GOTO gzCompresssFile_Error
                     END IF
                     #ENDIF
                  
                     iLeft =  LOF(hInput) MOD %DECOMPRESS_BLOCK_SIZE
                     iBlocks = (LOF(hInput) - iLeft) / %DECOMPRESS_BLOCK_SIZE
                     sInput = SPACE$(%DECOMPRESS_BLOCK_SIZE)
                     IF ERR THEN
                        g_gzLastError = "Error allocating " + FORMAT$(%DECOMPRESS_BLOCK_SIZE) + " bytes of memory"
                        GOTO gzCompresssFile_Error
                     END IF
                  
                     FOR i = 1 TO iBlocks
                        GET #hInput,, sInput
                        IF ERR THEN
                           g_gzLastError = "Error reading from: " + inFile + " Error =" + STR$(ERR)
                           GOTO gzCompresssFile_Error
                        END IF
                  
                        iReturn = gzwrite(hOutput, BYVAL STRPTR(sInput), LEN(sInput))
                        IF iReturn <> LEN(sInput) THEN
                           g_gzLastError= "Error compressing data buffer: " + FORMAT$(iReturn)
                           GOTO gzCompresssFile_Error
                        END IF
                     NEXT i
                  
                     IF iLeft > 0 THEN
                        sInput = SPACE$(iLeft)
                        IF ERR THEN
                           g_gzLastError = "Error allocating " + FORMAT$(iLeft) + " bytes of memory"
                           GOTO gzCompresssFile_Error
                        END IF
                  
                        GET #hInput,, sInput
                        IF ERR THEN
                           g_gzLastError = "Error reading from: " + inFile + " Error =" + STR$(ERR)
                           GOTO gzCompresssFile_Error
                        END IF
                  
                        iReturn = gzwrite(hOutput, BYVAL STRPTR(sInput), LEN(sInput))
                        IF iReturn <> LEN(sInput) THEN
                           g_gzLastError= "Error compressing data buffer: " + FORMAT$(iReturn)
                           GOTO gzCompresssFile_Error
                        END IF
                     END IF
                  
                     '- Clean up and return OK
                     '  If we make it this far, then the
                     '  compression worked!
                     '
                     CLOSE #hInput
                     gzclose hOutput
                     FUNCTION = %True
                     '============
                     EXIT FUNCTION
                     '============
                  
                  gzCompresssFile_Error:
                     IF hInput THEN CLOSE hInput
                     IF hOutput THEN gzclose hOutput
                     FUNCTION = %False
                  
                  END FUNCTION
                  
                  '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                  '  gzUncompressFile
                  '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                  FUNCTION gzUncompressFile(compFile AS STRING, outFile AS STRING) AS LONG
                  
                     DIM hInput AS LONG
                     DIM hOutput AS LONG
                     DIM iReturn AS LONG
                     DIM iCount AS LONG
                     DIM sOutput AS STRING
                  
                     '- Initialize the error message
                     g_gzLastError = "Success"
                  
                     '- The input must exist
                     IF DIR$(compFile) = "" THEN
                        g_gzLastError = "Compressed file " + compFile + " not found"
                        GOTO gzDecompresssFile_Error
                     END IF
                  
                     '- The output cannot exist
                     IF DIR$(outFile) <> "" THEN
                        g_gzLastError = "Output file: " + outFile + " already exists"
                        GOTO gzDecompresssFile_Error
                     END IF
                  
                     '- Tell zLib to open the output file
                     hInput = gzopen(BYCOPY compFile, $Z_OPEN_READ)
                     IF hInput = 0 THEN
                        g_gzLastError = "zLib is unable to open compressed file: " + compFile
                        GOTO gzDecompresssFile_Error
                     END IF
                  
                     '- Use PB to open the output file
                     ON ERROR RESUME NEXT
                     hOutput = FREEFILE
                     OPEN outFile FOR BINARY AS #hOutput
                     IF ERR THEN
                        hOutput = 0
                        g_gzLastError = "Unable to open output file: " + compFile + " Error =" + STR$(ERR)
                        GOTO gzDecompresssFile_Error
                     END IF
                  
                     sOutput = STRING$(%DECOMPRESS_BLOCK_SIZE, 0)
                     DO
                        iCount = iCount + 1
                  
                        iReturn = gzread(hInput, BYVAL STRPTR(sOutput), %DECOMPRESS_BLOCK_SIZE)
                        IF iReturn < 1 THEN
                           EXIT DO
                        ELSEIF iReturn < %DECOMPRESS_BLOCK_SIZE THEN
                           sOutput = LEFT$(sOutput, iReturn)
                           PUT #hOutput,, sOutput
                           EXIT DO
                        ELSE
                           PUT #hOutput,, sOutput
                        END IF
                        IF ERR THEN
                           g_gzLastError = "Error writing output file: " + outFile + " Error =" + STR$(ERR)
                           GOTO gzDecompresssFile_Error
                        END IF
                  
                     LOOP
                  
                     '- Clean up and return OK
                     '  If we make it this far, then the
                     '  compression worked!
                     '
                     CLOSE #hOutput
                     gzclose hInput
                     FUNCTION = %True
                     '============
                     EXIT FUNCTION
                     '============
                  
                  gzDecompresssFile_Error:
                     IF hOutput THEN CLOSE hOutput
                     IF hInput THEN gzclose hInput
                     FUNCTION = %False
                  
                  END FUNCTION
                  
                  '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                  '  gzCompressString
                  '  Compresses the string
                  '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                  FUNCTION gzCompressString(BYVAL deString AS STRING, compString AS STRING) AS LONG
                  
                     DIM iReturn AS LONG
                     DIM iComp AS LONG
                     DIM iDeComp AS LONG
                  
                     IF LEN(deString) < 1  THEN
                        FUNCTION = %False
                     ELSE
                  
                        '- Calculate and allocate the compression buffer.
                        compString = STRING$(LEN(deString) * 1.2 + 12, 0)
                        iComp = LEN(compString)
                        iDeComp = LEN(deString)
                  
                        '- Compress it
                        iReturn = compress(BYVAL STRPTR(compString), iComp, BYVAL STRPTR(deString), iDeComp)
                        IF iReturn = %Z_OK THEN
                  
                           '- compString will contain the length of the decompressed buffer
                           '  in the first 4 bytes.
                           '
                           compString = MKL$(iDecomp) + LEFT$(compString, iComp)
                           FUNCTION = %True
                        ELSE
                           compString = ""
                           g_gzLastError = "Error compressing buffer. zLib err =" + STR$(iReturn)
                           FUNCTION = %False
                        END IF
                     END IF
                  
                  END FUNCTION
                  
                  '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                  FUNCTION gzDecompressString(BYVAL compString AS STRING, deString AS STRING) AS LONG
                  
                     DIM iReturn AS LONG
                     DIM iComp AS LONG
                     DIM iDeComp AS LONG
                  
                     iComp = LEN(compString)
                     IF iComp < 5 THEN
                        FUNCTION = %False
                     ELSE
                  
                        '- The first 4 bytes contain the length of the decompressee string
                        iDeComp = CVL(LEFT$(compString, 4))
                        iComp = iComp - 4
                        compString = MID$(compString, 5)
                  
                        '- Create the decompression buffer
                        deString = SPACE$(iDeComp)
                        iReturn = uncompress(BYVAL STRPTR(deString), iDeComp, BYVAL STRPTR(compString), iComp)
                        IF iReturn = %Z_OK THEN
                           FUNCTION = %True
                        ELSE
                           FUNCTION = %False
                        END IF
                     END IF
                  
                  END FUNCTION

                  Comment


                  • #10
                    Hi Mike

                    Where can we download zlib.dll ?
                    I went to the following website - but the downloads are in source code and needs to be compiled in C

                    http://www.winimage.com/zLibDll/

                    Comment


                    • #11
                      Anne,

                      Try the "Binaries" @ http://gnuwin32.sourceforge.net/packages/zlib.htm

                      Pierre

                      Comment


                      • #12
                        I use version 1.2.3.0 which was renamed to SQLiteningZLib.dll in SQLitening (74,240 bytes.)
                        I sent you a private message with a link to what I use.

                        Another very popular version is 1.2.8 which I had some problems with SQLitening (didn't find a reason.)
                        I see there is a version 1.2.10 at http://zlib.net

                        I see Pierre posted at the same time as I did.
                        The link he posted has a version 1.2.3.2027 in the binaries that I have not tested.


                        Properties of the version 1.2.3.0 Click image for larger version  Name:	zlib.png Views:	1 Size:	5.2 KB ID:	756625




                        Last edited by Mike Doty; 6 Jan 2017, 11:15 PM.

                        Comment


                        • #13
                          There is also this link:
                          https://forum.powerbasic.com/forum/u...or-zip-program
                          Click image for larger version  Name:	compress.png Views:	1 Size:	2.2 KB ID:	756627


                          Code:
                          DECLARE FUNCTION ZlibCompress LIB "zlib123.dll" ALIAS "compress" _
                             (compr AS ANY, comprLen AS DWORD, buf AS ANY, BYVAL buflen AS DWORD)AS LONG
                          
                          DECLARE FUNCTION ZlibUncompress LIB "zlib123.dll" ALIAS "uncompress" _
                          (uncompr AS ANY, uncomprLen AS DWORD, compr AS ANY, BYVAL lcompr AS DWORD)AS LONG
                          
                          FUNCTION PBMAIN AS LONG 'compress.bas
                          
                            s$ = REPEAT$(40,CHR$(48 TO 58,65 TO 90,97 TO 122)+$CR)
                            c$ = Compress   (s$)
                            u$ = Uncompress (c$)
                            ? u$,,USING$("Compressed length # bytes",LEN(c$))
                          
                          END FUNCTION
                          
                          FUNCTION Compress (rsTextIn AS STRING) AS STRING
                             LOCAL wsTextOut AS STRING, llDo AS LONG,lspIn,lspOut AS STRING PTR
                             lspIn = VARPTR(rsTextIn):lspOut = VARPTR(wsTextOut)
                             @lspOut = SPACE$(LEN(@lspIn) * 1.2 + 12)
                             llDo = LEN(@lspOut)
                             ZlibCompress BYVAL STRPTR(@lspOut), llDo, BYVAL STRPTR(@lspIn), LEN(@lspIn)
                             FUNCTION = MKDWD$(LEN(@lspIn)) & LEFT$(@lspOut, llDo)
                          END FUNCTION
                          
                          FUNCTION UnCompress(rsTextIn AS STRING) AS STRING
                             LOCAL wsTextOut AS STRING, lspIn,lspOut AS STRING PTR
                             lspIn = VARPTR(rsTextIn):lspOut = VARPTR(wsTextOut)
                             @lspOut = SPACE$(CVDWD(@lspIn))
                             ZLibUncompress BYVAL STRPTR(@lspOut),LEN(@lspOut),BYVAL STRPTR(@lspIn)+4,LEN(@lspIn)-4
                             FUNCTION [email protected]
                          END FUNCTION
                          
                          FUNCTION CompressFile(sInputFile AS STRING, sOutputFile AS STRING) AS LONG
                             LOCAL sData AS STRING, hFile, result AS LONG
                             result = FileToString(sInputFile,sData)         'input file to string
                            IF result THEN FUNCTION = result:EXIT FUNCTION  'if any error then exit
                             IF ISFILE(sOutputFile) THEN  'need new output file
                              KILL sOutputFile
                              IF ERR THEN
                                FUNCTION = ERR
                                EXIT FUNCTION
                              END IF
                            END IF
                            sData = Compress(sData)
                            hFile = FREEFILE
                            OPEN sOutputFile FOR BINARY AS #hFile
                            IF ERR THEN FUNCTION = ERR:EXIT FUNCTION
                            IF LEN(sData) THEN PUT$ #hFile,sData
                            IF ERR THEN FUNCTION = ERR
                            CLOSE #hFile
                          END FUNCTION
                          
                          FUNCTION FileToString(sInputFile AS STRING,sData AS STRING) AS LONG
                            LOCAL hFile,FileLen AS LONG 'return 0 on success
                            IF ISFALSE(ISFILE(sInputFile)) THEN FUNCTION = 53:EXIT FUNCTION
                            hFile = FREEFILE
                            OPEN sInputFile FOR BINARY AS #hFile
                            IF ERR THEN FUNCTION = ERR:EXIT FUNCTION
                            FileLen = LOF(#hFile)
                            IF FileLen = 0 THEN
                              FUNCTION = -99
                            ELSE
                              GET$ #hFile,FileLen,sData
                              FUNCTION = ERR
                            END IF
                            CLOSE #hFile
                          END FUNCTION




                          Last edited by Mike Doty; 7 Jan 2017, 12:46 AM.

                          Comment


                          • #14
                            Thanks so much guys, downloaded Pierre's link and it works

                            Comment


                            • #15
                              I've used zlib for quite some time but have had to be careful to test for the existence of the zlib dll file (explicit loading). The other day, I noticed that the Win32API contains some data compression functions here. The good news is that I don't need to keep up on zlib revisions and make sure that the zlib dll is available. The M$ compression functions also seem compress data just a well and as fast as the zlib functions. The bad news (for some people) is that compression only seems to be available for Windows 8 and later - which is not a problem for my work. In any case, here's some test code that I've been playing with.

                              Code:
                              #COMPILE EXE
                              #DIM ALL
                              
                              #INCLUDE "win32api.inc" ' Need this for random data generation
                              
                              DECLARE FUNCTION CreateCompressor LIB "Cabinet.dll" ALIAS "CreateCompressor" ( _
                                  BYVAL Algorithm           AS DWORD, _
                                  BYVAL AllocationRoutines  AS LONG, _
                                  BYREF CompressorHandle    AS LONG _
                                  ) AS LONG
                              
                              DECLARE FUNCTION CreateDecompressor LIB "Cabinet.dll" ALIAS "CreateDecompressor" ( _
                                  BYVAL Algorithm           AS DWORD, _
                                  BYVAL AllocationRoutines  AS LONG, _
                                  BYREF DompressorHandle    AS LONG _
                                  ) AS LONG
                              
                              DECLARE FUNCTION CloseCompressor LIB "Cabinet.dll" ALIAS "CloseCompressor" ( _
                                  BYVAL CompressorHandle AS LONG _
                                  ) AS LONG
                              
                              DECLARE FUNCTION CloseDecompressor LIB "Cabinet.dll" ALIAS "CloseDecompressor" ( _
                                  BYVAL DecompressorHandle AS LONG _
                                  ) AS LONG
                              
                              DECLARE FUNCTION Compress LIB "Cabinet.dll" ALIAS "Compress" ( _
                                  BYVAL CompressorHandle      AS LONG, _
                                  BYVAL UncompressedData      AS LONG, _  ' Pointer
                                  BYVAL UncompressedDataSize  AS LONG, _
                                  BYVAL CompressedBuffer      AS LONG, _  ' Pointer
                                  BYVAL CompressedBufferSize  AS LONG, _
                                  BYREF CompressedDataSize    AS LONG _
                                  ) AS LONG
                              
                              DECLARE FUNCTION Decompress LIB "Cabinet.dll" ALIAS "Decompress" ( _
                                  BYVAL DecompressorHandle      AS LONG, _
                                  BYVAL CompressedData          AS LONG, _  ' Pointer
                                  BYVAL CompressedDataSize      AS LONG, _
                                  BYVAL UncompressedBuffer      AS LONG, _  ' Pointer
                                  BYVAL UncompressedBufferSize  AS LONG, _
                                  BYREF UncompressedDataSize    AS LONG _
                                  ) AS LONG
                              
                              %COMPRESS_ALGORITHM_MSZIP       = 2
                              %COMPRESS_ALGORITHM_XPRESS      = 3   ' Fastest, good compression and low memory
                              %COMPRESS_ALGORITHM_XPRESS_HUFF = 4
                              %COMPRESS_ALGORITHM_LZMS        = 5
                              
                              FUNCTION cngRNGBuff ( _
                                  BYVAL pBuff AS LONG, _              'IN: Ptr to buffer to hold random data
                                  BYVAL dLen  AS LONG _               'IN: Length of random data to write to buffer
                                  ) THREADSAFE AS LONG                'RET: Err val or zero if no errors
                              
                                STATIC hProv  AS LONG
                              
                                '-- If this is the first time that this is called then open a CNG provider (should never fail).
                                IF ISFALSE(hProv) THEN
                                  BCryptOpenAlgorithmProvider(hProv, $$BCRYPT_RNG_ALGORITHM, $$NUL, 0)
                                END IF
                              
                                '-- Any errors will be caused by a null buffer pointer or length. Bad values will prob GPF.
                                IF BCryptGenRandom ( _
                                    hProv, _
                                    pBuff, _
                                    dLen, _
                                    %NULL) THEN
                                  FUNCTION = 1234
                                END IF
                              
                              END FUNCTION
                              
                              
                              FUNCTION PBMAIN () AS LONG
                                LOCAL hComp, hdComp AS LONG
                                LOCAL sInBuff, sOutBuff, sFinal AS STRING
                                LOCAL dSize, bSize, ret, nErr AS LONG
                              
                                '-- Create the compressor and decompressor objects.
                                ret = CreateCompressor ( _
                                    %COMPRESS_ALGORITHM_XPRESS, _   ' Choose an algorithm
                                    0, _                            ' No allocation routines
                                    hComp _                         ' Handle for object
                                    )                               ' Not zero = success
                                nErr = GetLastError
                                PRINT "CreateCompressor ret =" ret " Handle =" hComp
                                IF ISFALSE ret THEN
                                  PRINT "  Function error =" nErr
                                  GOTO ExitMain
                                END IF
                              
                                ret = CreateDecompressor ( _
                                    %COMPRESS_ALGORITHM_XPRESS, _   ' Choose an algorithm
                                    0, _                            ' No allocation routines
                                    hDComp _                        ' Handle for object
                                    )                               ' Not zero = success
                                nErr = GetLastError
                                PRINT "CreateDecompressor ret =" ret " Handle =" hDComp
                                IF ISFALSE ret THEN
                                  PRINT "  Function error =" nErr
                                  GOTO ExitMain
                                END IF
                              
                                '-- Create buffer with some compressible data.
                                sInBuff += "Of all the fishes in the sea, the mermaid is the one for me."
                                sInBuff += "The quick brown fox jumps over the lazy dogs back."
                                sInBuff += "Of all the fishes in the sea, the mermaid is the one for me."
                                sInBuff += "The quick brown fox jumps over the lazy dogs back."
                                sInBuff += "Of all the fishes in the sea, the mermaid is the one for me."
                                sInBuff += "The quick brown fox jumps over the lazy dogs back."
                                sInBuff += "Of all the fishes in the sea, the mermaid is the one for me."
                                sInBuff += "The quick brown fox jumps over the lazy dogs back."
                              
                                '-- Use this to create a buffer full of random data.
                              '  sInBuff = space$(90000)
                              '  cngRNGBuff(strptr(sInBuff), len(sInBuff))
                              
                                PRINT "Uncompressed data size =" LEN(sInBuff)
                              
                                '-- Get recommended compression output buffer size (bSize).
                                ret = Compress(hComp, STRPTR(sInBuff), LEN(sInBuff), 0, 0, bSize)
                                nErr = GetLastError
                                PRINT "Compress (get buff size) ret =" ret " bSize =" bSize
                                IF (ISFALSE ret) AND (nErr <> %ERROR_INSUFFICIENT_BUFFER) THEN
                                  PRINT " Function error =" nErr
                                  GOTO ExitMain
                                END IF
                              
                                '-- Compress the data and get the size of the compressed data.
                                sOutBuff = SPACE$(bSize)
                                ret = Compress(hComp, STRPTR(sInBuff), LEN(sInBuff), STRPTR(sOutBuff), LEN(sOutBuff), dSize)
                                nErr = GetLastError
                                PRINT "Compress (compress data) ret =" ret " dSize =" dSize
                                IF (ISFALSE ret) AND (nErr <> %ERROR_INSUFFICIENT_BUFFER) THEN
                                  PRINT " Function error =" nErr
                                  GOTO ExitMain
                                END IF
                              
                                '-- Get recommended decompression output buffer size.
                                ret = Decompress(hDComp, STRPTR(sOutBuff), dSize, 0, 0, bSize)
                                nErr = GetLastError
                                PRINT "Decompress (get buff size) ret =" ret " bSize =" bSize
                                IF (ISFALSE ret) AND (nErr <> %ERROR_INSUFFICIENT_BUFFER) THEN
                                  PRINT " Function error =" nErr
                                  GOTO ExitMain
                                END IF
                              
                                '-- Decompress the data and get the decompressed data size.
                                sFinal = SPACE$(bSize)  ' Buffer to hold decompressed data
                                ret = Decompress(hDComp, STRPTR(sOutBuff), dSize, STRPTR(sFinal), LEN(sFinal), dSize)
                                nErr = GetLastError
                                PRINT "Decompress (decompress data) ret =" ret " dSize =" dSize
                                IF (ISFALSE ret) AND (nErr <> %ERROR_INSUFFICIENT_BUFFER) THEN
                                  PRINT " Function error =" nErr
                                  GOTO ExitMain
                                END IF
                              
                                '-- Test output data.
                                IF sInBuff <> sFinal THEN
                                  PRINT "Data does not match!"
                                ELSE
                                  PRINT "No errors"
                                END IF
                              
                              Exitmain:
                                '-- Clean up objects.
                                IF hComp THEN CloseCompressor hComp
                                IF hDComp THEN CloseDecompressor hdComp
                              
                                PRINT "Finished"
                                WAITKEY$
                              
                              END FUNCTION

                              Comment


                              • #16
                                Jerry's code is PBCC specific. Following is modified to work with both PBWIn and PBCC (just required a rewrite of the PRINT lines to use "?" and STR$() for numerics plus conditional WATITKEY$)

                                '
                                Code:
                                #COMPILE EXE
                                #DIM ALL
                                
                                #INCLUDE "win32api.inc" ' Need this for random data generation
                                
                                DECLARE FUNCTION CreateCompressor LIB "Cabinet.dll" ALIAS "CreateCompressor" ( _
                                    BYVAL Algorithm           AS DWORD, _
                                    BYVAL AllocationRoutines  AS LONG, _
                                    BYREF CompressorHandle    AS LONG _
                                    ) AS LONG
                                
                                DECLARE FUNCTION CreateDecompressor LIB "Cabinet.dll" ALIAS "CreateDecompressor" ( _
                                    BYVAL Algorithm           AS DWORD, _
                                    BYVAL AllocationRoutines  AS LONG, _
                                    BYREF DompressorHandle    AS LONG _
                                    ) AS LONG
                                
                                DECLARE FUNCTION CloseCompressor LIB "Cabinet.dll" ALIAS "CloseCompressor" ( _
                                    BYVAL CompressorHandle AS LONG _
                                    ) AS LONG
                                
                                DECLARE FUNCTION CloseDecompressor LIB "Cabinet.dll" ALIAS "CloseDecompressor" ( _
                                    BYVAL DecompressorHandle AS LONG _
                                    ) AS LONG
                                
                                DECLARE FUNCTION Compress LIB "Cabinet.dll" ALIAS "Compress" ( _
                                    BYVAL CompressorHandle      AS LONG, _
                                    BYVAL UncompressedData      AS LONG, _  ' Pointer
                                    BYVAL UncompressedDataSize  AS LONG, _
                                    BYVAL CompressedBuffer      AS LONG, _  ' Pointer
                                    BYVAL CompressedBufferSize  AS LONG, _
                                    BYREF CompressedDataSize    AS LONG _
                                    ) AS LONG
                                
                                DECLARE FUNCTION Decompress LIB "Cabinet.dll" ALIAS "Decompress" ( _
                                    BYVAL DecompressorHandle      AS LONG, _
                                    BYVAL CompressedData          AS LONG, _  ' Pointer
                                    BYVAL CompressedDataSize      AS LONG, _
                                    BYVAL UncompressedBuffer      AS LONG, _  ' Pointer
                                    BYVAL UncompressedBufferSize  AS LONG, _
                                    BYREF UncompressedDataSize    AS LONG _
                                    ) AS LONG
                                
                                %COMPRESS_ALGORITHM_MSZIP       = 2
                                %COMPRESS_ALGORITHM_XPRESS      = 3   ' Fastest, good compression and low memory
                                %COMPRESS_ALGORITHM_XPRESS_HUFF = 4
                                %COMPRESS_ALGORITHM_LZMS        = 5
                                
                                FUNCTION cngRNGBuff ( _
                                    BYVAL pBuff AS LONG, _              'IN: Ptr to buffer to hold random data
                                    BYVAL dLen  AS LONG _               'IN: Length of random data to write to buffer
                                    ) THREADSAFE AS LONG                'RET: Err val or zero if no errors
                                
                                  STATIC hProv  AS LONG
                                
                                  '-- If this is the first time that this is called then open a CNG provider (should never fail).
                                  IF ISFALSE(hProv) THEN
                                    BCryptOpenAlgorithmProvider(hProv, $$BCRYPT_RNG_ALGORITHM, $$NUL, 0)
                                  END IF
                                
                                  '-- Any errors will be caused by a null buffer pointer or length. Bad values will prob GPF.
                                  IF BCryptGenRandom ( _
                                      hProv, _
                                      pBuff, _
                                      dLen, _
                                      %NULL) THEN
                                    FUNCTION = 1234
                                  END IF
                                
                                END FUNCTION
                                
                                
                                FUNCTION PBMAIN () AS LONG
                                  LOCAL hComp, hdComp AS LONG
                                  LOCAL sInBuff, sOutBuff, sFinal AS STRING
                                  LOCAL dSize, bSize, ret, nErr AS LONG
                                
                                  '-- Create the compressor and decompressor objects.
                                  ret = CreateCompressor ( _
                                      %COMPRESS_ALGORITHM_XPRESS, _   ' Choose an algorithm
                                      0, _                            ' No allocation routines
                                      hComp _                         ' Handle for object
                                      )                               ' Not zero = success
                                  nErr = GetLastError
                                  ? "CreateCompressor ret =" & STR$(ret) &  " Handle =" & STR$(hComp)
                                  IF ISFALSE ret THEN
                                    ? "  Function error =" & STR$(nErr)
                                    GOTO ExitMain
                                  END IF
                                
                                  ret = CreateDecompressor ( _
                                      %COMPRESS_ALGORITHM_XPRESS, _   ' Choose an algorithm
                                      0, _                            ' No allocation routines
                                      hDComp _                        ' Handle for object
                                      )                               ' Not zero = success
                                  nErr = GetLastError
                                  ? "CreateDecompressor ret =" & STR$(ret) & " Handle =" & STR$(hDComp)
                                  IF ISFALSE ret THEN
                                    ? "  Function error =" & STR$(nErr)
                                    GOTO ExitMain
                                  END IF
                                
                                  '-- Create buffer with some compressible data.
                                  sInBuff += "Of all the fishes in the sea, the mermaid is the one for me."
                                  sInBuff += "The quick brown fox jumps over the lazy dogs back."
                                  sInBuff += "Of all the fishes in the sea, the mermaid is the one for me."
                                  sInBuff += "The quick brown fox jumps over the lazy dogs back."
                                  sInBuff += "Of all the fishes in the sea, the mermaid is the one for me."
                                  sInBuff += "The quick brown fox jumps over the lazy dogs back."
                                  sInBuff += "Of all the fishes in the sea, the mermaid is the one for me."
                                  sInBuff += "The quick brown fox jumps over the lazy dogs back."
                                
                                  '-- Use this to create a buffer full of random data.
                                '  sInBuff = space$(90000)
                                '  cngRNGBuff(strptr(sInBuff), len(sInBuff))
                                
                                  ? "Uncompressed data size =" & STR$(LEN(sInBuff))
                                
                                  '-- Get recommended compression output buffer size (bSize).
                                  ret = Compress(hComp, STRPTR(sInBuff), LEN(sInBuff), 0, 0, bSize)
                                  nErr = GetLastError
                                  ? "Compress (get buff size) ret =" & STR$(ret) &  " bSize =" & STR$(bSize)
                                  IF (ISFALSE ret) AND (nErr <> %ERROR_INSUFFICIENT_BUFFER) THEN
                                    ? " Function error =" & STR$(nErr)
                                    GOTO ExitMain
                                  END IF
                                
                                  '-- Compress the data and get the size of the compressed data.
                                  sOutBuff = SPACE$(bSize)
                                  ret = Compress(hComp, STRPTR(sInBuff), LEN(sInBuff), STRPTR(sOutBuff), LEN(sOutBuff), dSize)
                                  nErr = GetLastError
                                  ? "Compress (compress data) ret =" & STR$(ret) &  " dSize =" & STR$(dSize)
                                  IF (ISFALSE ret) AND (nErr <> %ERROR_INSUFFICIENT_BUFFER) THEN
                                    ? " Function error =" & STR$(nErr)
                                    GOTO ExitMain
                                  END IF
                                
                                  '-- Get recommended decompression output buffer size.
                                  ret = Decompress(hDComp, STRPTR(sOutBuff), dSize, 0, 0, bSize)
                                  nErr = GetLastError
                                  ? "Decompress (get buff size) ret =" & STR$(ret) & " bSize =" & STR$(bSize)
                                  IF (ISFALSE ret) AND (nErr <> %ERROR_INSUFFICIENT_BUFFER) THEN
                                    ? " Function error =" & STR$(nErr)
                                    GOTO ExitMain
                                  END IF
                                
                                  '-- Decompress the data and get the decompressed data size.
                                  sFinal = SPACE$(bSize)  ' Buffer to hold decompressed data
                                  ret = Decompress(hDComp, STRPTR(sOutBuff), dSize, STRPTR(sFinal), LEN(sFinal), dSize)
                                  nErr = GetLastError
                                  ? "Decompress (decompress data) ret =" & STR$(ret) & " dSize =" & STR$(dSize)
                                  IF (ISFALSE ret) AND (nErr <> %ERROR_INSUFFICIENT_BUFFER) THEN
                                    ? " Function error =" & STR$(nErr)
                                    GOTO ExitMain
                                  END IF
                                
                                  '-- Test output data.
                                  IF sInBuff <> sFinal THEN
                                    ? "Data does not match!"
                                  ELSE
                                    ? "No errors"
                                  END IF
                                
                                Exitmain:
                                  '-- Clean up objects.
                                  IF hComp THEN CloseCompressor hComp
                                  IF hDComp THEN CloseDecompressor hdComp
                                
                                  ? "Finished"
                                  #IF %DEF(%PB_CC32)
                                   WAITKEY$
                                  #ENDIF
                                
                                END FUNCTION
                                '

                                Comment


                                • #17
                                  And if for any reason, you want something embedded in Windows since XP...

                                  Code:
                                  [noparse]
                                  #COMPILE EXE '#Win#
                                  #DIM ALL
                                  #OPTION VERSION5 'XP+
                                  #INCLUDE "Win32Api.inc"
                                  #INCLUDE "ntStatus.inc"
                                  
                                  $AppName = "MS Compression"
                                  
                                  'Thank to José Roca for the declares
                                  DECLARE FUNCTION RtlCompressBuffer LIB "NtDll.dll" ALIAS "RtlCompressBuffer" _
                                  (BYVAL CompressionFormat       AS WORD, _
                                   BYVAL SourceBuffer            AS BYTE POINTER, _
                                   BYVAL SourceBufferLength      AS DWORD, _
                                   BYVAL DestinationBuffer       AS BYTE POINTER, _
                                   BYVAL DestinationBufferLength AS DWORD, _
                                   BYVAL Unknow                  AS DWORD, _
                                   BYREF pDestinationSize        AS DWORD, _
                                   BYVAL WorkspaceBuffer         AS DWORD) AS LONG
                                  
                                  DECLARE FUNCTION RtlGetCompressionWorkSpaceSize LIB "NtDll.dll" ALIAS "RtlGetCompressionWorkSpaceSize" _
                                  (BYVAL CompressionFormat       AS WORD,  _
                                   BYREF pNeededBufferSize       AS DWORD, _
                                   BYREF pUnknown                AS DWORD)  AS LONG
                                  
                                  DECLARE FUNCTION RtlDecompressBuffer LIB "NtDll.dll" ALIAS "RtlDecompressBuffer" _
                                  (BYVAL CompressionFormat       AS WORD, _
                                   BYVAL DestinationBuffer       AS BYTE POINTER, _
                                   BYVAL DestinationBufferLength AS DWORD, _
                                   BYVAL SourceBuffer            AS BYTE POINTER, _
                                   BYVAL SourceBufferLength      AS DWORD, _
                                   BYREF pDestinationSize        AS DWORD) AS LONG
                                  
                                  'The RtlDecompressFragment function is used to decompress part of a compressed buffer (that is, a buffer "fragment").
                                  DECLARE FUNCTION RtlDecompressFragment LIB "NtDll.dll" ALIAS "RtlDecompressFragment" _
                                  (BYVAL CompressionFormat        AS WORD, _
                                   BYVAL UncompressedFragment     AS BYTE POINTER, _
                                   BYVAL UncompressedFragmentSize AS DWORD, _
                                   BYVAL CompressedBuffer         AS BYTE POINTER, _
                                   BYVAL CompressedBufferSize     AS DWORD, _
                                   BYVAL FragmentOffset           AS DWORD, _
                                   BYREF FinalUncompressedSize    AS DWORD, _
                                   BYVAL WorkSpace                AS DWORD) AS LONG
                                  '______________________________________________________________________________
                                  
                                  FUNCTION Compress(BYVAL sUncompressed AS STRING, BYREF sCompressed AS STRING) AS DWORD
                                   LOCAL sWorkBuffer       AS STRING
                                   LOCAL UnCompressedLen   AS DWORD
                                   LOCAL BufferLen         AS DWORD
                                   LOCAL CompressedLen     AS DWORD
                                   LOCAL FormatAndEngine   AS DWORD
                                   LOCAL WorkSpaceLenAsked AS DWORD
                                   LOCAL FragmentLenAsked  AS DWORD
                                   LOCAL dwRetVal          AS DWORD
                                  
                                   FormatAndEngine = MAK(DWORD, %COMPRESSION_FORMAT_LZNT1, %COMPRESSION_ENGINE_MAXIMUM) '%COMPRESSION_ENGINE_STANDARD
                                   RtlGetCompressionWorkSpaceSize(FormatAndEngine, WorkSpaceLenAsked, FragmentLenAsked)
                                   sWorkBuffer     = NUL$(WorkSpaceLenAsked)
                                   UnCompressedLen = LEN(sUncompressed)
                                   BufferLen       = 4 + UnCompressedLen '4 for UnCompressedLen DWORD.
                                   sCompressed     = NUL$(BufferLen)
                                   dwRetVal = RtlCompressBuffer(BYVAL FormatAndEngine, _
                                                                STRPTR(sUncompressed), _
                                                                BYVAL UnCompressedLen, _
                                                                BYVAL STRPTR(sCompressed) + 4, _ '4 for UnCompressedLen DWORD
                                                                BYVAL BufferLen - 4, _
                                                                4096, _ 'MSDN: 4096 is recommended.
                                                                CompressedLen, _
                                                                BYVAL STRPTR(sWorkBuffer))
                                   IF dwRetVal <> %STATUS_SUCCESS THEN 'Aka %STATUS_BUFFER_TOO_SMALL, if any error, return the original string
                                     'Compress output might be bigger than input if in is already compressed like a .png for example,
                                     'in this case kepp original uncompressed data.
                                     sCompressed = MKDWD$(UnCompressedLen) & sUncompressed 'INVALID_FILE_SIZE for unable to compress, out is bigger than in.
                                     FUNCTION = UnCompressedLen
                                     SetLastError(%STATUS_BUFFER_TOO_SMALL) 'Optionnal. %STATUS_SUCCESS %STATUS_BUFFER_ALL_ZEROS %STATUS_INVALID_PARAMETER %STATUS_UNSUPPORTED_COMPRESSION %STATUS_NOT_SUPPORTED %STATUS_BUFFER_TOO_SMALL
                                   ELSE
                                     POKE DWORD, STRPTR(sCompressed), UnCompressedLen 'UnCompressedLen DWORD
                                     sCompressed = LEFT$(sCompressed, CompressedLen + 4) '4 for UnCompressedLen DWORD
                                     FUNCTION = CompressedLen
                                   END IF
                                  
                                  END FUNCTION
                                  '______________________________________________________________________________
                                  
                                  FUNCTION DeCompress(BYVAL sCompressed AS STRING, BYREF sDeCompressed AS STRING) AS DWORD
                                   LOCAL DeCompressedLenResult AS DWORD
                                   LOCAL DeCompressedLen       AS DWORD
                                   LOCAL dwRetVal              AS DWORD
                                  
                                   DeCompressedLen = PEEK(DWORD, STRPTR(sCompressed))
                                   IF DeCompressedLen = 0 THEN 'Nothing to decompress
                                     sDeCompressed = ""
                                     FUNCTION      = 0
                                     SetLastError(%STATUS_NO_DATA_DETECTED) 'Optionnal.
                                   ELSEIF DeCompressedLen = LEN(sCompressed) - 4 THEN 'Was not compressed
                                     sDeCompressed = MID$(sCompressed, 5) 'Remove DWORD lenght
                                     FUNCTION      = DeCompressedLen
                                   ELSE
                                     sDeCompressed = NUL$(DeCompressedLen)
                                     dwRetVal = RtlDeCompressBuffer(%COMPRESSION_FORMAT_LZNT1, _
                                                                  BYVAL STRPTR(sDeCompressed), _
                                                                  BYVAL DeCompressedLen, _
                                                                  BYVAL STRPTR(sCompressed) + 4, _ 'Bypass DWORD for DeCompressedLen
                                                                  BYVAL LEN(sCompressed) - 4, _    'Less DWORD for DeCompressedLen
                                                                  DeCompressedLenResult)
                                     IF DeCompressedLen <> DeCompressedLenResult THEN 'Some error
                                       SetLastError(dwRetVal) 'Optionnal. %STATUS_SUCCESS %STATUS_BUFFER_ALL_ZEROS %STATUS_INVALID_PARAMETER %STATUS_UNSUPPORTED_COMPRESSION %STATUS_NOT_SUPPORTED %STATUS_BUFFER_TOO_SMALL
                                       sDeCompressed = ""
                                       FUNCTION      = 0
                                     ELSE
                                       FUNCTION = DeCompressedLenResult
                                     END IF
                                   END IF
                                  
                                  END FUNCTION
                                  '______________________________________________________________________________
                                  
                                  FUNCTION GetFragment(BYVAL sCompressed AS STRING, BYREF sFragment AS STRING, _
                                                       BYVAL FragmentOffset AS DWORD, BYVAL FragmentLen AS DWORD) AS DWORD
                                   LOCAL sWorkBuffer           AS STRING
                                   LOCAL UncompressedLenResult AS DWORD
                                   LOCAL FormatAndEngine       AS DWORD
                                   LOCAL WorkSpaceLenAsked     AS DWORD
                                   LOCAL FragmentLenAsked      AS DWORD
                                   LOCAL dwRetVal              AS DWORD
                                  
                                   IF LEN(sCompressed) = 0 THEN
                                     sFragment = ""
                                     FUNCTION  = 0
                                     SetLastError(%STATUS_NO_DATA_DETECTED) 'Optionnal.
                                   ELSE
                                     IF PEEK(DWORD, STRPTR(sCompressed)) = LEN(sCompressed) THEN 'Was not compressed
                                       sFragment = MID$(sCompressed, FragmentOffset + 1 + 4, FragmentLen) '4 to bypass first DWORD lenght, 1 for zero to one based api vs ddt
                                       FUNCTION  = LEN(sFragment)
                                     ELSE
                                       FormatAndEngine = MAK(DWORD, %COMPRESSION_FORMAT_LZNT1, %COMPRESSION_ENGINE_MAXIMUM) '%COMPRESSION_ENGINE_STANDARD
                                       RtlGetCompressionWorkSpaceSize(FormatAndEngine, WorkSpaceLenAsked, FragmentLenAsked)
                                       sWorkBuffer = NUL$(FragmentLenAsked)
                                       sFragment   = NUL$(FragmentLen)
                                  
                                       'The RtlDecompressFragment function is used to decompress part of a compressed buffer (that is, a buffer "fragment").
                                       dwRetVal = RtlDecompressFragment(%COMPRESSION_FORMAT_LZNT1, _
                                                                      BYVAL STRPTR(sFragment), _
                                                                      BYVAL LEN(sFragment), _
                                                                      BYVAL STRPTR(sCompressed) + 4, _ 'Bypass DWORD for UnCompressedLen
                                                                      BYVAL LEN(sCompressed) - 4, _    'Less DWORD for UnCompressedLen
                                                                      BYVAL FragmentOffset, _          'Position in uncompressed buffer
                                                                      BYREF UncompressedLenResult, _
                                                                      BYVAL STRPTR(sWorkBuffer))
                                       IF UncompressedLenResult <> FragmentLen THEN
                                         SetLastError(dwRetVal) '%STATUS_SUCCESS %STATUS_INVALID_PARAMETER %STATUS_UNSUPPORTED_COMPRESSION %COMPRESSION_FORMAT_LZNT1 %COMPRESSION_FORMAT_NONE %COMPRESSION_FORMAT_DEFAULT %STATUS_BAD_COMPRESSION_BUFFER
                                         sFragment = ""
                                         FUNCTION  = 0
                                       ELSE
                                         FUNCTION = LEN(sFragment)
                                       END IF
                                     END IF
                                   END IF
                                  
                                  END FUNCTION
                                  '______________________________________________________________________________
                                  
                                  FUNCTION PBMAIN() AS LONG
                                   LOCAL hFile           AS DWORD
                                   LOCAL UnCompressedLen AS DWORD
                                   LOCAL DeCompressedLen AS DWORD
                                   LOCAL CompressedLen   AS DWORD
                                   LOCAL FragmentLen     AS DWORD
                                   LOCAL FragmentOffset  AS DWORD
                                   LOCAL sUncompressed   AS STRING
                                   LOCAL sDecompressed   AS STRING
                                   LOCAL sCompressed     AS STRING
                                   LOCAL sFragment       AS STRING
                                   LOCAL zFileName       AS ASCIIZ * %MAX_PATH
                                  
                                   'Get sUncompressed from a file
                                   GetSystemDirectory(zFileName, %MAX_PATH)
                                   zFileName &= "\Shell32.DLL"
                                   'zFileName = "D:\Basic\Bas\SRC\Graf\~Img\PNG_Transparency.png" 'Try with already highly compressed .png data
                                   hFile = FREEFILE : OPEN zFileName FOR BINARY AS hFile : GET$ hFile, LOF(hFile), sUncompressed : CLOSE hFile
                                  
                                   'Get sUncompressed from code
                                   'sUncompressed = REPEAT$(100000, CHR$(0 TO 255)) 'Try this...
                                  
                                   UnCompressedLen = LEN(sUncompressed)
                                   CompressedLen   = Compress(sUncompressed, sCompressed)
                                   DeCompressedLen = DeCompress(sCompressed, sDeCompressed)
                                  
                                   MessageBox(%HWND_DESKTOP, _
                                              "UnCompressedLen " & $TAB & FORMAT$(UnCompressedLen, "000,###,###") & $CRLF & _
                                              "CompressedLen "   & $TAB & FORMAT$(CompressedLen,   "000,###,###") & $CRLF & _
                                              "DeCompressedLen"  & $TAB & FORMAT$(DeCompressedLen, "000,###,###"), _
                                              $AppName, %MB_OK OR %MB_TOPMOST)
                                  
                                   FragmentOffset = 100 'Give offset as if it was in a decompressed buffer.
                                   FragmentLen    = 1024
                                   FragmentLen    = GetFragment(sCompressed, sFragment, FragmentOffset, FragmentLen)
                                   MessageBox(%HWND_DESKTOP, _
                                              "FragmentOffset " & $TAB & FORMAT$(FragmentOffset, "000,###,###") & $CRLF & _
                                              "FragmentLen "    & $TAB & FORMAT$(FragmentLen, "000,###,###"), _
                                              $AppName & " - Fragment", %MB_OK OR %MB_TOPMOST)
                                  
                                   sUncompressed   = "A"
                                   UnCompressedLen = LEN(sUncompressed)
                                   CompressedLen   = Compress(sUncompressed, sCompressed)
                                   DeCompressedLen = DeCompress(sCompressed, sDeCompressed)
                                  
                                   MessageBox(%HWND_DESKTOP, _
                                              "UnCompressedLen " & $TAB & FORMAT$(UnCompressedLen, "000,###,###") & $CRLF & _
                                              "CompressedLen "   & $TAB & FORMAT$(CompressedLen,   "000,###,###") & $CRLF & _
                                              "DeCompressedLen"  & $TAB & FORMAT$(DeCompressedLen, "000,###,###"), _
                                              $AppName, %MB_OK OR %MB_TOPMOST)
                                  
                                   sUncompressed   = REPEAT$(100, "A") & "Tim" & REPEAT$(100, "B")
                                   UnCompressedLen = LEN(sUncompressed)
                                   CompressedLen   = Compress(sUncompressed, sCompressed)
                                   DeCompressedLen = DeCompress(sCompressed, sDeCompressed)
                                  
                                   MessageBox(%HWND_DESKTOP, _
                                              "UnCompressedLen " & $TAB & FORMAT$(UnCompressedLen, "000,###,###") & $CRLF & _
                                              "CompressedLen "   & $TAB & FORMAT$(CompressedLen,   "000,###,###") & $CRLF & _
                                              "DeCompressedLen"  & $TAB & FORMAT$(DeCompressedLen, "000,###,###"), _
                                              $AppName, %MB_OK OR %MB_TOPMOST)
                                  
                                   FragmentOffset = 100 'Give offset as if it was in a decompressed buffer.
                                   FragmentLen    = 3
                                   FragmentLen    = GetFragment(sCompressed, sFragment, FragmentOffset, FragmentLen)
                                   MessageBox(%HWND_DESKTOP, _
                                              "Fragment       " & $TAB & $DQ & sFragment & $DQ & $CRLF & _
                                              "FragmentOffset " & $TAB & FORMAT$(FragmentOffset, "000,###,###") & $CRLF & _
                                              "FragmentLen    " & $TAB & FORMAT$(FragmentLen,    "000,###,###")  & $CRLF & _
                                              "CompressedLen  " & $TAB & FORMAT$(CompressedLen,  "000,###,###"), _
                                              $AppName & " - Fragment", %MB_OK OR %MB_TOPMOST)
                                  
                                   END FUNCTION
                                  '_____________________________________________________________________________
                                  '
                                  [/noparse]
                                  Last edited by Pierre Bellisle; 13 Oct 2020, 03:34 PM. Reason: Now handle already highly compressed data

                                  Comment


                                  • #18
                                    I've switched to LZ4 for most of my string compression, and zSTD for the rest. zLib served me well for many years, but both of the new routines are significantly faster.

                                    LZ4 is much faster, but you sacrifice compression ratio for speed.

                                    zSTD is slower than LZ4 / much faster than zLib, but gives better compression ratio, somewhere between LZ4 and zLib.

                                    Using production data in my testing, zlib creates the smallest (22%), zstd next (27%), lz4 largest (29%). But, in order of speed it was LZ4, ZSTD, zLib.

                                    Both lz4 and zstd support dictionaries which are supposed to enhance compression ratio and speed, but I never finished testing those.

                                    Check them out: LZ4 and ZSTD. There is a good benchmark table where you can compare several algos.

                                    If anyone has any interest, I could probably dig up some of the test code I used.

                                    Comment


                                    • #19
                                      Originally posted by Raymond Leech View Post
                                      I've switched to LZ4 for most of my string compression, and zSTD for the rest.
                                      Have you compared them to aPLib (it comes with a PB .inc and sample code) ? http://ibsensoftware.com/products_aPLib.html


                                      Comment


                                      • #20
                                        Originally posted by Stuart McLachlan View Post
                                        Have you compared them to aPLib
                                        I haven't used aPLib since probably 2000. I switched to addCrypt/addZip until 2018 or so. Maybe I'll compare them in my next go-around. Thanks for reminding me they still exist Stuart!


                                        Comment

                                        Working...
                                        X