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)

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