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:timm@trm-ug.com
    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:timm@trm-ug.com
    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:timm@trm-ug.com
        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:timm@trm-ug.com
              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:timm@trm-ug.com
                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
                  '  ddickinson@usinternet.com
                  '  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, 10: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 =@lspout
                          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; 6 Jan 2017, 11:46 PM.

                          Comment


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

                            Comment

                            Working...
                            X