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