02-29-2004, 08:57 PM
I Downloaded this file but I can't get it to work, can anyone tell me whats wrong with it? I have made no changes to the code (I made it easier to read, made everything single line, IE removed all the 'nana: more: even more: and then yet some more' lines)
The original header of the file:
And here's the Compression sub:
It only outputs empty files (char 0 or 32 not sure, doesent matter, it's wrong)
If anyone has a working LZW, or other, compression algo, besides RLE, and would like to share, please tell me.
I have searched for another LZW compressor, without results. Only thing I found was the theory behind it and some C code (I suck at C, really I do, so I couldn't translate it
)
The original header of the file:
Code:
'___
' |he Code Post
' `-' Original Submission
' ===============================================================
' CONTRIBUTOR: Anonymous
' DESCRIPTION: Easy to use LZW Commpressor/Decompressor SUBS.
' DATE POSTED: Unknown
' ===============================================================
'LZWSUBS.BAS
'LZW Commpressor/Decompressor SUBS.
'------------------------------------------------
'THIS IS ADAPTED CODE ORIGINALY BY RICH GELDREICH
'------------------------------------------------
'This version fulfills one item on the ABC "wish list"
'to make an easy to use LZW compressor in a single SUB.
'Using the ABC's own resources this wish is now granted.
'Original LZW code is by Rich Geldreich found in one
'of the All Basic Code Packets.
'The code is mostly the same, I just re-arranged it into
'Two SUB's to make it easier to add to other programs.
'Rich deserves all credit for this tool, so I'm not
'going to add my name to it. I don't know how it works.
'Thanks to Rich for the LZW code.
'Here's the original header.
'=======================================================================
'Experimental LZW Compressor for PDS / QuickBASIC 4.5
'By Rich Geldreich 1992
'This program is in the public domain: use as you wish!
'(QB4.5 users: Use search & replace to change all of the "SSEG" strings
'to "VARSEG" strings in this program.)
'If you have and questions or problems, write/call:
'Rich Geldreich
'410 Market St.
'Gloucester City, NJ 08030
'(609)-742-8752
'
' Do not press ctrl+break while this program is decompressing!
'========================================================================And here's the Compression sub:
Code:
SUB LZWC (File$, LZWfile$)
DEF SEG
True = -1
False = 0
DIM Prefix(6576), Suffix(6576), Code(6576), Used(4096)
DIM Shift(12) AS LONG
FOR A = 0 TO 12
Shift(A) = 2 ^ A
NEXT
InBuffer$ = STRING$(4000, 0)
OutBuffer$ = STRING$(4000, 0)
A& = SADD(OutBuffer$) - 65536 * (A& < 0)
OSeg = VARSEG(OutBuffer$) + (A& \ 16)
OAddress = (A& MOD 16)
OStartAddress = OAddress
OEndAddress = OAddress + 4000
OPEN File$ FOR BINARY AS #1
FileLength& = LOF(1)
OPEN LZWfile$ FOR BINARY AS #2
CurrentLoc& = 2
StartCode = 259
NextCode = 259
MaxCode = 512
CodeSize = 9
CurrentBit = 0
Char& = 0
FOR A = 0 TO 6576
Prefix(A) = -1
Suffix(A) = -1
Code(A) = -1
NEXT
IF IAddress = IEndAddress THEN
GET #1, , InBuffer$
A& = SADD(InBuffer$) - 65536 * (A& < 0)
Iseg = VARSEG(InBuffer$) + (A& \ 16)
IAddress = (A& MOD 16)
IEndAddress = IAddress + 4000
END IF
DEF SEG = Iseg
Prefix = PEEK(IAddress)
IAddress = IAddress + 1
DO
DO
IF CurrentLoc& > FileLength& THEN
A = Prefix
GOSUB PutCode
A = 256
GOSUB PutCode
A = 0
GOSUB PutCode
A = 0
GOSUB PutCode
OutBuffer$ = LEFT$(OutBuffer$, OAddress - OStartAddress)
PUT #2, , OutBuffer$
CLOSE 1, 2
EXIT SUB
ELSE
IF IAddress = IEndAddress THEN
GET #1, , InBuffer$
A& = SADD(InBuffer$) - 65536 * (A& < 0)
Iseg = VARSEG(InBuffer$) + (A& \ 16)
IAddress = (A& MOD 16)
IEndAddress = IAddress + 4000
END IF
DEF SEG = Iseg
Suffix = PEEK(IAddress)
IAddress = IAddress + 1
CurrentLoc& = CurrentLoc& + 1
Index = (Prefix * 256& XOR Suffix) MOD 6577
IF Index = 0 THEN
Offset = 1
ELSE
Offset = 6577 - Index
END IF
DO
IF Code(Index) = -1 THEN
Found = False
EXIT DO
ELSEIF Prefix(Index) = Prefix AND Suffix(Index) = Suffix THEN
Found = True
EXIT DO
ELSE
Index = Index - Offset
IF Index < 0 THEN Index = Index + 6577
END IF
LOOP
IF Found = True THEN
Prefix = Code(Index)
Used(Prefix) = Used(Prefix) + 1
END IF
END IF
LOOP WHILE Found = True
DO WHILE Prefix >= MaxCode AND CodeSize < 12
A = 257
GOSUB PutCode
MaxCode = MaxCode * 2
CodeSize = CodeSize + 1
LOOP
A = Prefix
GOSUB PutCode
Prefix(Index) = Prefix
Suffix(Index) = Suffix
Code(Index) = NextCode
Prefix = Suffix
NextCode = NextCode + 1
IF NextCode > 4096 THEN
A = 258
GOSUB PutCode
REDIM P(4096), S(4096), U(4096) AS LONG, Pn(4096), C(4096)
REDIM location(4096)
Num.Entries = 0
FOR A = 0 TO 6576
C = Code(A)
IF C <> -1 THEN
IF Used(C) > 0 THEN
Used(C) = 0
P = Prefix(A)
S = Suffix(A)
P(Num.Entries) = P
S(Num.Entries) = S
U(Num.Entries) = P * 4096& + S
C(C) = Num.Entries
Num.Entries = Num.Entries + 1
END IF
END IF
NEXT
Num.Entries = Num.Entries - 1
FOR A = 0 TO Num.Entries
Pn(A) = A
NEXT
Mid = Num.Entries \ 2
DO
FOR A = 0 TO Num.Entries - Mid
IF U(Pn(A)) > U(Pn(A + Mid)) THEN
SWAP Pn(A), Pn(A + Mid)
Swap.Flag = True
CompareLow = A - Mid
CompareHigh = A
DO WHILE CompareLow >= 0
IF U(Pn(CompareLow)) > U(Pn(CompareHigh)) THEN
SWAP Pn(CompareLow), Pn(CompareHigh)
CompareHigh = CompareLow
CompareLow = CompareLow - Mid
ELSE
EXIT DO
END IF
LOOP
END IF
NEXT
Mid = Mid \ 2
LOOP WHILE Mid > 0
FOR A = 0 TO Num.Entries
location(Pn(A)) = A
NEXT
FOR A = 0 TO 6576
Prefix(A) = -1
Suffix(A) = -1
Code(A) = -1
NEXT
FOR A1 = 0 TO Num.Entries
A = Pn(A1)
P = P(A)
S = S(A)
IF P >= StartCode THEN P = StartCode + location(C(P))
IF S >= StartCode THEN S = StartCode + location(C(S))
Index = (P * 256& XOR S) MOD 6577
IF Index = 0 THEN Offset = 1 ELSE Offset = 6577 - Index
DO
IF Code(Index) = -1 THEN
Found = False
EXIT DO
ELSEIF Prefix(Index) = P AND Suffix(Index) = S THEN
Found = True
EXIT DO
ELSE
Index = Index - Offset
IF Index < 0 THEN Index = Index + 6577
END IF
LOOP
Prefix(Index) = P
Suffix(Index) = S
Code(Index) = A1 + StartCode
NEXT
New.Entries = Num.Entries + 1
NextCode = New.Entries + StartCode
IF NextCode > 4096 THEN
FOR A = 0 TO 6576
Prefix(A) = -1
Suffix(A) = -1
Code(A) = -1
NEXT
NextCode = StartCode
END IF
CodeSize = 9
MaxCode = 512
END IF
LOOP
CLOSE 1: CLOSE 2
EXIT SUB
PutCode:
IF A >= MaxCode THEN CLOSE 1, 2: EXIT SUB 'was STOP
Char& = Char& + A * Shift(CurrentBit)
CurrentBit = CurrentBit + CodeSize
DO WHILE CurrentBit > 7
IF OAddress = OEndAddress THEN
PUT #2, , OutBuffer$
OAddress = OStartAddress
END IF
DEF SEG = OSeg
POKE OAddress, Char& AND 255
OAddress = OAddress + 1
Char& = Char& \ 256
CurrentBit = CurrentBit - 8
LOOP
RETURN
END SUBIt only outputs empty files (char 0 or 32 not sure, doesent matter, it's wrong)
If anyone has a working LZW, or other, compression algo, besides RLE, and would like to share, please tell me.
I have searched for another LZW compressor, without results. Only thing I found was the theory behind it and some C code (I suck at C, really I do, so I couldn't translate it
)
