Advanced

Simple

Advanced

Simple

Algorithm creator(s)

Timm Motl

PB author(s)

Timm Motl

Description

Custom string compressor/decompressor

Note

Very fast compression/decompression

Source

https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/23567-string-compressor-decompressor?t=22954

See also

n/a

Source Code

Download source code file stringcompr.bas (Right-click -> "Save as ...")

#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