Code:
'//////////////////////////////////////////////////////////////////////////
'// Tiny String Compression Functions //
'//////////////////////////////////////////////////////////////////////////
%nTest = 1 ' to have correct timing
%LZ78_DICTIONARY = 65535?? ' < 64K
%LZ78_NIL = %LZ78_DICTIONARY
FUNCTION Compress(BYVAL ptrInData AS DWORD, BYVAL LenInData AS DWORD, BYVAL ptrOutData AS DWORD, BYVAL ptrTmpData AS DWORD) AS DWORD
#REGISTER NONE
! push ptrTmpData
! push LenInData
! push ptrInData
! push ptrOutData
! call CompressStart
! mov FUNCTION, eax
EXIT FUNCTION
CompressStart:
! sub edx, edx
! xchg eax, edx
! pushad
! mov ebp, esp
! and ecx, eax
! mov edi, [ebp+&h30]
! cld
! mov ch, &h40
! push edi
! rep stosd
! sub edx, &h2864E25C
! mov esi, [ebp+&h28]
! jnz pack0
! dec edx
pack0:
! push ecx
! sub ax, &h0AEB6
! mov edi, [ebp+&h24]
! pop ebx
! stosw
! xchg eax, edx
! pop ebp
! stosd
! push edi
! xchg eax, edx
! push esp
pack1:
! test cl, 7
! lodsb
! jnz pack3
! xchg edx, [esp]
! adc ah, dl
! pop edx
! xchg edi, [esp]
! ror edx, 1
! mov [edi], ah
! jc pack2
! xor edx, &h2C047C3E
pack2:
! pop edi
! mov ah, &h0FF
! push edi
! xor edx, &h76C52B8D
! inc edi
! push edx
pack3:
! cmp al, [ebx+ebp]
! jz pack5
! ror edx, 1
! mov [ebx+ebp], al
! jnc pack4
! xor edx, &h2C047C3E
pack4:
! mov bh, al
! xor edx, &h5AC157B3
! adc al, dl
! stosb
! mov al, bh
! stc
pack5:
! inc ecx
! mov bh, bl
! rcl ah, 1
! cmp ecx, [esp+&h34]
! mov bl, al
! jc pack1
! ror ah, cl
! pop ebx
! add ah, bl
! pop esi
! mov ebp, esp
! sub edi, [ebp+&h24]
! mov [ebp+&h14], edx
! xchg ah, [esi]
! add [ebp+&h1C], edi
! popad
! ret &h10
END FUNCTION
FUNCTION Decompress(BYVAL ptrInData AS DWORD, BYVAL LenInData AS DWORD, BYVAL ptrOutData AS DWORD, BYVAL ptrTmpData AS DWORD) AS DWORD
#REGISTER NONE
! push ptrTmpData
! push LenInData
! push ptrInData
! push ptrOutData
! call DeCompressStart
! mov FUNCTION, eax
EXIT FUNCTION
DeCompressStart:
! sub eax, eax
! pushad
! mov ebp, esp
! and ecx, eax
! mov edi, [ebp+&h30]
! cld
! mov ch, &h40
! push edi
! rep stosd
! mov esi, [ebp+&h28]
! xchg ebx, eax
! add ecx, [ebp+&h2C]
! lodsw
! mov edi, [ebp+&h24]
! add ecx,-6
! pop ebp
! lodsd
! xchg eax, edx
unpack0:
! test byte ptr [esp+&h1C], 7
! jnz unpack2
! ror edx, 1
! jecxz unpack5
! jnc unpack1
! xor edx, &h2C047C3E
unpack1:
! lodsb
! dec ecx
! xor edx, &h5AC157B3
! sbb al, dl
! mov ah, al
unpack2:
! shl ah, 1
! inc byte ptr [esp+&h1C]
! jnc unpack4
! ror edx, 1
! jecxz unpack5
! jc unpack3
! xor edx, &h2C047C3E
unpack3:
! lodsb
! dec ecx
! xor edx, &h76C52B8D
! sbb al, dl
! mov [ebx+ebp], al
unpack4:
! mov al, [ebx+ebp]
! mov bh, bl
! stosb
! mov bl, al
! jmp unpack0
! dec edx
! push ecx
unpack5:
! sub edi, [esp+&h24]
! mov [esp+&h1C], edi
! popad
! ret &h10
END FUNCTION
FUNCTION DeCompress_LZ(InBuf AS STRING, OutBuf AS STRING) AS LONG
#REGISTER NONE
DIM Parents(%LZ78_DICTIONARY - 1) AS LOCAL WORD
DIM lz_array(%LZ78_DICTIONARY - 1) AS LOCAL BYTE
DIM abcPos AS LOCAL WORD, abcSize AS LOCAL WORD
DIM InStreamSize AS LOCAL WORD, InStreamPos AS LOCAL WORD
DIM OutBufPos AS LOCAL DWORD, rOutBufPos AS DWORD, OutBufSize AS LOCAL DWORD
DIM InBufPos AS LOCAL DWORD, InBufSize AS LOCAL DWORD
DIM LastInBufPos AS LOCAL DWORD
DIM Parent AS LOCAL WORD, rParent AS LOCAL WORD
DIM Initialized AS LOCAL LONG
OutBuf = "": InBufSize = LEN(InBuf)
DO
IF Initialized = 0 THEN
IF LastInBufPos >= InBufSize THEN EXIT DO
IF LastInBufPos = 0 THEN
OutBufSize = CVDWD(InBuf, 1): LastInBufPos = 4
OutBuf = SPACE$(OutBufSize)
REDIM bOutBuf(0) AS LOCAL BYTE AT STRPTR(OutBuf) - 1
END IF
InStreamSize = CVDWD(InBuf, LastInBufPos + 1)
REDIM InStream(0) AS LOCAL WORD AT STRPTR(InBuf) + LastInBufPos + 2
LastInBufPos = LastInBufPos + 2 + InStreamSize * 2
abcSize = CVDWD(InBuf, LastInBufPos + 1)
REDIM lz_array(0) AS LOCAL BYTE AT STRPTR(InBuf) + LastInBufPos + 2
LastInBufPos = LastInBufPos + 2 + abcSize
IF (abcSize MOD 2) THEN INCR LastInBufPos
InStreamPos = 0: abcPos = 0
Initialized = 1
' MsgBox Str$(abcSize) + Str$(InStreamSize) + Str$(LastInBufPos)
END IF
Parent = InStream(InStreamPos)
IF abcPos < abcSize THEN
Parents(abcPos) = Parent
Parent = abcPos
INCR abcPos
END IF
OutBufPos = rOutBufPos
rParent = Parent
WHILE rParent <> %LZ78_NIL
INCR OutBufPos
rParent = Parents(rParent)
WEND
WHILE Parent <> %LZ78_NIL
INCR rOutBufPos
bOutBuf(OutBufPos) = lz_array(Parent)
DECR OutBufPos
Parent = Parents(Parent)
WEND
INCR InstreamPos
IF InStreamPos >= InStreamSize THEN Initialized = 0
LOOP
END FUNCTION
FUNCTION Compress_LZ (InBuf AS STRING, OutBuf AS STRING) AS LONG
#REGISTER NONE
DIM Parents(%LZ78_DICTIONARY - 1) AS LOCAL WORD
DIM Childs(%LZ78_DICTIONARY - 1) AS WORD
DIM FirstChild(%LZ78_NIL) AS WORD
DIM lz_array(%LZ78_DICTIONARY - 1) AS LOCAL BYTE
DIM OutStream(%LZ78_DICTIONARY - 1) AS LOCAL WORD
DIM Top(255) AS LOCAL WORD
DIM OutStreamPos AS LOCAL WORD
DIM abcPos AS LOCAL WORD
DIM InBufSize AS LOCAL DWORD, InBufPos AS DWORD
DIM Parent AS LOCAL WORD, rParent AS LOCAL WORD, tParent AS LOCAL WORD
DIM Symbol AS LOCAL BYTE, AlignMent AS LOCAL STRING
DIM Initialized AS LOCAL LONG
OutBuf = ""
InBufSize = LEN(InBuf): IF InBufSize = 0 THEN FUNCTION = -1: EXIT FUNCTION
REDIM bInBuf(0) AS BYTE AT STRPTR(InBuf) - 1
FOR InBufPos = 1 TO InBufSize
IF Initialized = 0 THEN
FOR tParent = 0 TO 255: Top(tParent) = %LZ78_NIL: NEXT
FirstChild(%LZ78_NIL) = %LZ78_NIL: Parent = %LZ78_NIL
abcPos = 0: OutStreamPos = 0
Initialized = 1
END IF
Symbol = bInBuf(InBufPos)
IF Parent = %LZ78_NIL THEN
IF Top(Symbol) <> %LZ78_NIL THEN tParent = Top(Symbol) ELSE tParent = %LZ78_NIL
ELSE
tParent = FirstChild(Parent)
WHILE tParent <> %LZ78_NIL
IF lz_array(tParent) = Symbol THEN EXIT DO ELSE tParent = Childs(tParent)
WEND
END IF
IF tParent = %LZ78_NIL THEN
IF Parent = %LZ78_NIL THEN Top(Symbol) = abcPos
lz_array(abcPos) = Symbol
Parents(abcPos) = Parent
rParent = FirstChild(Parent)
Childs(abcPos) = rParent
FirstChild(Parent) = abcPos
FirstChild(abcPos) = %LZ78_NIL
OutStream(OutStreamPos) = Parent: INCR OutStreamPos
INCR abcPos
Parent = %LZ78_NIL
ELSE
Parent = tParent
END IF
IF (abcPos >= %LZ78_DICTIONARY) OR (InBufPos = InBufSize) THEN
IF Parent <> %LZ78_NIL THEN OutStream(OutStreamPos) = Parent: INCR OutStreamPos
IF (abcPos MOD 2) THEN AlignMent = " " ELSE AlignMent = ""
IF OutBuf = "" THEN OutBuf = MKDWD$(InBufSize) ' header
OutBuf = OutBuf + MKWRD$(OutStreamPos) + PEEK$(VARPTR(OutStream(0)), OutStreamPos * 2) + _
MKWRD$(abcPos) + PEEK$(VARPTR(lz_array(0)), abcPos) + AlignMent
Initialized = 0
END IF
NEXT
END FUNCTION
FUNCTION ut_Compress(sInData AS STRING, lSlowCompress AS LONG) AS LONG
LOCAL sOutData AS STRING
LOCAL sTmpData AS STRING * 65535
LOCAL OutSize AS DWORD
LOCAL lResult AS LONG
'// Compress it ...
IF LEN(sInData)>7 THEN
IF lSlowCompress = %TRUE THEN
IF Compress_LZ(sInData, sOutData) >= 0 THEN
sInData = "UT_LZ7" & sOutData
lResult = %TRUE
END IF
ELSE
sOutData = STRING$(LEN(sInData) * 2, 0)
OutSize = Compress(BYVAL STRPTR(sInData), BYVAL LEN(sInData), BYVAL STRPTR(sOutData), BYVAL VARPTR(sTmpData))
IF OutSize < LEN(sInData) THEN
sInData = "UT_CMP" & LEFT$(sOutData, OutSize)
lResult = %TRUE
END IF
END IF
END IF
FUNCTION = lResult
END FUNCTION
FUNCTION ut_Decompress(sSourceData AS STRING) AS STRING
LOCAL sInData AS STRING
LOCAL sOutData AS STRING
LOCAL sTmpData AS STRING * 65535
LOCAL OutSize AS DWORD
IF LEFT$(sSourceData, 6) = "UT_LZ7" THEN
sInData = MID$(sSourceData,7)
IF DeCompress_LZ(sInData, sOutData) <> 0 THEN
FUNCTION = sOutData
ELSE
FUNCTION = sSourceData
END IF
ELSEIF LEFT$(sSourceData, 6) = "UT_CMP" THEN
'// Remove header
sInData = MID$(sSourceData,7)
sOutData = STRING$(LEN(sInData) * 10,0) '// allocate enough space
OutSize = Decompress(BYVAL STRPTR(sInData), BYVAL LEN(sInData), BYVAL STRPTR(sOutData), BYVAL VARPTR(sTmpData))
FUNCTION = LEFT$(sOutData, OutSize)
ELSE
FUNCTION = sSourceData
END IF
END FUNCTION
FUNCTION CompressFormat ALIAS "CompressFormat" (sFileMarker AS STRING, sSourceFormat AS STRING) EXPORT AS STRING
DIM sResult AS STRING
'// Compress the passed format buffer... first 7 bytes are a header
sResult = MID$(sSourceFormat, LEN(sFileMarker) + 1)
IF ut_Compress(sResult, %FALSE) = %TRUE THEN
'// Compress OK, return passed buffer as result
FUNCTION = sFileMarker & sResult
ELSE
'// Problem somewhere, just pass back the original string
FUNCTION = sSourceFormat
END IF
END FUNCTION
FUNCTION DECOMPRESSFORMAT ALIAS "DECOMPRESSFORMAT" (sFileMarker AS STRING, sSourceFormat AS STRING) EXPORT AS STRING
DIM sResult AS STRING
'// DeCompress the passed format buffer... check for header
sResult = MID$(sSourceFormat, LEN(sFileMarker) + 1)
FUNCTION = sFileMarker & ut_Decompress(sResult)
END FUNCTION
Bookmarks