' ///////////////////////////////////////////////////////////////////////
' /// Байт-ориентированный алгоритм сжатия LzG12.15 ///
' /// средняя степень сжатия ~55% c
vladimir.gv@mail.ru ///
' ///////////////////////////////////////////////////////////////////////
' = lzg12.bas =
#Include Once "windows.bi"
#Define LZG12OptRazm(razmer) (razmer-1 And Not(SizeOf(Integer)-1)) + SizeOf(Integer) ' оптимизация (выравнивание) размера для CopyMemory
Function CompressLzg12(vhMas As UByte Ptr,_ ' функция возвращает: >0 размер сжатого; 0 - пусто; -1 - ошибка
vhMasRazm As Integer,_
ByRef vihMas As UByte Ptr) As Integer
If vhMas = 0 Or vhMasRazm = 0 Then Return 0 ' нет входных данных
vihMas = Allocate(vhMasRazm*1.14+16) ' создаём выходной массив нужного размера
If vihMas = 0 Then Return -1 ' если ошибка захвата памяти для выходного массива
#Macro ZapDopBait(znah) ' запись допБайтов
If znah <= &hFF Then ' будет 1 допБайт со значением
*adrVih = znah
Else ' >255 - нужны ещё допБайты, а первый будет командным (adr=2;3;4)
adr = adrVih : i = znah : *adr = 0
Do
*adr += 1 : adrVih += 1
*adrVih = i : i Shr= 8
Loop While i > 0
EndIf
adrVih += 1
#EndMacro
#Macro ZapProp() ' запись пропусков в выходной массив
If prop < 7 Then ' в зависимости от длины пропусков формируем команду
*adrKomB = prop Shl 5 ' запись размера в 3 бита УпрБайта {ппп-----}
Else ' >6 нужны дополнительные байты для записи размера
*adrKomB = 7 Shl 5 : ZapDopBait(prop) ' запись значения "7" в 3 бита УпрБайта {111-----}
EndIf
CopyMemory(adrVih,vhMas+indIsh-prop,LZG12OptRazm(prop)) ' копируем пропуски
adrVih += prop : prop = 0 ' коректируем адрес записи; обнуляем значение пропусков
#EndMacro
Dim As Integer prop,dlna,rast,indSvp,indIsh
Dim As Integer i,h4,vhMasOgr
Dim As UByte Ptr adrKomB,adr,adrVih=vihMas+8
Dim As ULong poisk4(&hFFFF) ' хеш-таблица для поиска дубликатов
Poke ULong,vihMas,&H12477A4C ' запЗаглСжтДанных "LzG{12}": HEX=12-47-7A-4C(порядок: 3210)
Poke ULong,vihMas+4,vhMasRazm ' записываем размер исходного массива
If vhMasRazm > 7 Then vhMasOgr = vhMasRazm-8
prop = 1 : indIsh = 1 ' первый исхБайт попадает в пропуск
Do While indIsh < vhMasOgr ' пока не дошли до конца массива
h4 = (Peek(ULong,vhMas+indIsh) Shl 4) + (Peek(ULong,vhMas+indIsh) Shr 16) And &hFFFF ' вычисление хеш4 - перемешиваем старшие и младшие биты
indSvp = poisk4(h4) : poisk4(h4) = indIsh ' вычисление Адреса из сохрСчётчика; добавляем текИндекс в таблицу поиска
If Peek(ULong,vhMas+indSvp) = Peek(ULong,vhMas+indIsh) Then ' перв 4Б совпали
dlna = 4 : rast = indIsh-indSvp ' расширяем совпадение вправо
For i = indIsh+4 To vhMasOgr Step SizeOf(Integer) ' сверяем следующие по 4|8 байта
If Peek(Integer,vhMas+i) = Peek(Integer,vhMas+indSvp+dlna) Then
dlna += SizeOf(Integer)
Else
Exit For
EndIf
Next
For i = indIsh+dlna To vhMasRazm-1 ' сверяем следующие байты (побайтно)
If vhMas [i]= vhMas[indSvp+dlna] Then dlna += 1 Else Exit For
Next
' расширяем совпадение побайтно влево в пределах величины пропусков
Do While prop And indSvp > 0 AndAlso vhMas[indSvp-1] = vhMas[indIsh-1]
indSvp -= 1 : indIsh -= 1 : prop -= 1 : dlna += 1
Loop ' \\ двигаем индексы влево; корректируем параметры
adrKomB = adrVih : *adrKomB = 0 : adrVih += 1 ' резервТекКомандныйБайт(УпрБайт) и сохрЕгоАдрес
If prop Then ' если есть пропуски - кодируем их в выходной массив
ZapProp()
EndIf
If dlna < 11 Then ' dlna=4..10; длина совпадения влазит в УпрБайт {-----ддд}
*adrKomB Or= dlna-4 ' ддд = (0..6)+4 = 4..10 ' записываем длину в УпрБайт
Else ' нужны допБайты длины
*adrKomB Or= 7 ' запись значения "7" в 3 бита УпрБайта {-----ддд}
ZapDopBait(dlna)
EndIf
' запись Байтов Растояния в УпрБайте {---pр---} : рр = (0..3)+1 = 1..4 Байта
Poke ULong,adrVih,rast ' пишем значение в 4 Байта (смещением адреса подрежется)
Select Case rast ' определяем требуемое клво байт
Case Is <= &hFF : i = 1 ' 1 Байт
Case Is <= &hFFFF : i = 2 ' 2 Байта
Case Is <= &hFFFFFF : i = 3 ' 3 Байта
Case Else : i = 4 ' 4 Байта
End Select
*adrKomB Or= (i-1) Shl 3 : adrVih += i
indIsh += dlna : dlna = 0
Else ' если не был найден дубликат
prop += 1 : indIsh += 1
EndIf
Loop ' пока не дошли до конца массива
i = vhMasRazm-indIsh : prop += i : indIsh += i ' корректируем пропуски и указатель чтения
If prop > 0 Then ' если остались пропуски, то кодируем их в вых. массив
adrKomB = adrVih : adrVih += 1 ' резервТекКомандныйБайт
ZapProp() : *adrKomB Or= 7 ' запись команды в 3 бита УпрБайта {-----111}
*adrVih = 0 : adrVih += 1 ' запись нулевого допБайтДлнСовп
EndIf
Return (adrVih-vihMas-1 And Not(7)) + 8 ' выравниваем (добавляем) размер до кратного 8
End Function
Function DecompressLzg12(vhMas As UByte Ptr,_ ' Разжатие памяти
vhMasRazm As Integer,_ ' возвращает: >0 размер распакДанных; 0 - пусто; -1 - ошибка
ByRef vihMas As UByte Ptr) As Integer
#Macro HtDopBait(znah) ' чтение допБайтов
znah = *adrIsh : adrIsh += 1 ' читаем первый допБайт
If znah < 7 Then ' знач=2;3;4 - это команда чтения ещё 2;3;4 допБДлнПроп
znah = Peek(ULong,adrIsh) And msk(znah) ' читаем 4Б и убираем лишнее маской
adrIsh += *(adrIsh-1)
EndIf
#EndMacro
If vhMas = 0 Or vhMasRazm < 8 Then Return 0 ' нет входных данных
If Peek(ULong,vhMas) <> &H12477A4C Then Return -1 ' если нет заголовка "LzG{12}" (12-версия) HEX=12-47-7A-4C(порядок: 3210)
Var vihMasRazm = Peek(ULong,vhMas+4) ' читаем 4 байта размера конечного массива
If vihMasRazm = 0 Then Return 0 ' если нулевой размер
vihMas = Allocate(vihMasRazm+8) ' создаём вых.массив нужного размера
If vihMas = 0 Then Return -1 ' если не удалось захватить память для вых.массива
Dim As Integer prop,dlna,komBait,rast,i,msk(4)={0,&hFF,&hFFFF,&hFFFFFF,&hFFFFFFFF}
Dim As UByte Ptr iUk,adrVih=vihMas,adrIsh=vhMas+8,vihMasOgr=adrVih+vihMasRazm
Do
komBait = *adrIsh : adrIsh += 1 ' читаем очередной УпрБайт из исхМассива {пппррддд}
prop = komBait Shr 5 ' декодируем длину пропусков из 3 бит УпрБайта
If prop > 0 Then ' есть пропуски {ппп-----}
If prop = 7 Then ' {111-----} есть допБайтыДлнПропусков
HtDopBait(prop)
EndIf
CopyMemory(adrVih,adrIsh,LZG12OptRazm(prop)) ' копируем пропуски из вх. в вых. массив
adrIsh += prop : adrVih += prop
EndIf
' декодируем Длину дубликатов из УпрБайта {-----ддд}
dlna = (komBait And 7) + 4 ' ддд = (0..6)+4 = 4..10
If dlna = 11 Then ' {-----111} есть допБайтыДлнДубл
HtDopBait(dlna)
EndIf
If dlna > 0 Then ' читаем допБайтыРастояния, если есть совпадение
i = ((komBait Shr 3) And 3) + 1 ' декодируем 2 флаговых бита растояния {---рр---}
rast = Peek(ULong,adrIsh) And msk(i) ' читаем 4Б и убираем лишнее маской
adrIsh += i ' i = 1..4 - количество байтов для чтения значения
If dlna > rast Then ' растояние меньше длнСовпад (вложенное)
If rast >= 4 Then ' оптимизированное копирование блоками
For iUk = adrVih To adrVih+dlna-1 Step 4 ' копируем предыдущие по 4Б из выхМассива в конец выхМассива
Poke ULong, iUk, Peek(ULong,iUk-rast)
Next
ElseIf rast < 3 Then ' rast=1; rast=2
i = 4-rast
For iUk = adrVih To adrVih+i-1 ' дополняем побайтово до 4-х байтов
*iUk = *(iUk-rast)
Next
For iUk = adrVih+i To adrVih+dlna-1 Step 4 ' копируем предыдущие по 4Б из выхМассива в конец выхМассива
Poke ULong, iUk, Peek(ULong,iUk-4)
Next
Else ' rast=3 - копируем по 4 байта с наложением 1 байта
For iUk = adrVih To adrVih+dlna-1 Step 3 ' копируем предыдущие по 4Б из выхМассива в конец выхМассива
Poke ULong, iUk, Peek(ULong,iUk-3)
Next
EndIf
Else ' растояние больше длины совпадения (не вложенное)
CopyMemory(adrVih,adrVih-rast,LZG12OptRazm(dlna)) ' копируем совпадение
EndIf
adrVih += dlna
EndIf
Loop While adrVih < vihMasOgr
Return vihMasRazm
End Function
' функции для сжатия/расжатия Строк
#Macro CoDecStrLzg12(tip)
Dim As UByte Ptr ukz ' указатель на целевые данные
Var razmer = tip##Lzg12(SAdd(s),Len(s),ukz) ' получаем размер и указатель преобразованных данных
Dim As Integer dsSt(2) ={Cast(Integer,ukz),razmer,razmer+1} ' создаём псевдо дескриптор строки
Function = *Cast(String Ptr, @dsSt(0)) ' возвращаем полученые данные в виде строки
DeAllocate ukz
#EndMacro
Function CompressStrLzg12(s As String) As String
CoDecStrLzg12(Compress)
End Function
Function DecompressStrLzg12(s As String) As String
CoDecStrLzg12(Decompress)
End Function[/i]
