Pre-Compression Routine

 BBS: Inland Empire Archive
Date: 08-25-92 (10:12)             Number: 292
From: RICK PEDLEY                  Refer#: NONE
  To: ERIC FORD                     Recvd: NO  
Subj: Pre-Compression Routine        Conf: (2) Quik_Bas
 On 08-23-92 Eric Ford wrote to Rick Pedley...

 EF> Oh well, just an idea <grin>.  Well, maybe next time. Thanks though.
 EF> P.S.  Do you have one of these things?  If so, would you post it?

The one I use is from a commercial library but here's one that was
posted about a year ago:

*******************************************************************
  From: RICHARD VANNOY
    To: JOHN STRONG                                 Date: 25 Jul 91
  Subj: File Compression
  Attr:
*******************************************************************

DECLARE SUB Pack (Text$)
DECLARE SUB UnPack (Text$)
DEFINT A-Z
Text$ = "This is a test, see how it works."
PRINT Text$, "Len = "; LEN(Text$): PRINT
CALL Pack(Text$)
PRINT Text$, , "Len = "; LEN(Text$): PRINT
CALL UnPack(Text$)
PRINT Text$, "Len = "; LEN(Text$)
'
SUB Pack (Text$)
   D1$ = "abadafagahalamanaparasatbabbbebiblbobrcacccechclcocrdaddd"
   D2$ = "edredefehemenesetfafefiflfofrgageghgihahehihoicidifigihil"
   D3$ = "iminirisitjajejijojuouuekakekikokrlalilllnloltlymamemimon"
   D4$ = "anengninknnnontobocodofolomonoporosotpapepippqurardrerrro"
   D5$ = "sasesisssttatetitothunupwawe"
   Dict$ = D1$ + D2$ + D3$ + D4$ + D5$
   DO
      cnt = cnt + 1
      char$ = MID$(Text$, cnt, 2)
      IF cnt = LEN(Text$) THEN
         Text$ = temp$ + MID$(Text$, cnt, 1)
         EXIT SUB
      END IF
      xx = 1
ReDo:
      x = INSTR(xx, Dict$, char$)

       IF x > 0 THEN
         IF (x \ 2) = (x / 2) THEN
            xx = x + 1
            GOTO ReDo
         END IF
         temp$ = temp$ + CHR$((x \ 2) + 127)
         cnt = cnt + 1
      ELSE
         temp$ = temp$ + MID$(Text$, cnt, 1)
      END IF
   LOOP WHILE cnt < LEN(Text$)
   Text$ = temp$
END SUB
'
SUB UnPack (Text$)
   D1$ = "abadafagahalamanaparasatbabbbebiblbobrcacccechclcocrdaddd"
   D2$ = "edredefehemenesetfafefiflfofrgageghgihahehihoicidifigihil"
   D3$ = "iminirisitjajejijojuouuekakekikokrlalilllnloltlymamemimon"
   D4$ = "anengninknnnontobocodofolomonoporosotpapepippqurardrerrro"
   D5$ = "sasesisssttatetitothunupwawe"
   Dict$ = D1$ + D2$ + D3$ + D4$ + D5$
   temp$ = Text$
   Text$ = ""
   FOR x = 1 TO LEN(temp$)

      char = ASC(MID$(temp$, x, 1))
      IF char > 126 THEN
         Text$ = Text$ + MID$(Dict$, (char - 127) * 2 + 1, 2)
      ELSE
         Text$ = Text$ + MID$(temp$, x, 1)
      END IF
   NEXT
END SUB

I hope that this helps in some way.  Most text files
are compressed by about 25% using this routine.
I recently got this from one of the programming echoes.
___

... OFFLINE 1.40

--- Maximus 2.01wb
 * Origin: The BULLpen BBS * Intel 14.4EX (613)549-5168 (1:249/140)
Outer Court
Echo Basic Postings

Books at Amazon:

Back to BASIC: The History, Corruption, and Future of the Language

Hackers: Heroes of the Computer Revolution (including Tiny BASIC)

Go to: The Story of the Math Majors, Bridge Players, Engineers, Chess Wizards, Scientists and Iconoclasts who were the Hero Programmers of the Software Revolution

The Advent of the Algorithm: The Idea that Rules the World

Moths in the Machine: The Power and Perils of Programming

Mastering Visual Basic .NET