Есть у меня небольшой алгоритм сжатия на FreeBasic. Основан на LZ77 с окном 64КБ, байт ориентированный. Сжимает строку или участок памяти.
Исходный код лежит здесь: https://yadi.sk/d/qwM77O-h3KRoqY
Пример сжатия строки:Код
#Include "lzg.bas"
Dim As String mas2,mas="abracadabra abracadabra abracadabra abracadabra"
?:?" UPAKOVKA = ";
mas2=LzgCompress(mas):?"OK"
?" RASPAKOVKA = ";
Var mas3=LzgDecompress(mas2):?"OK"
?:? " razmer_ishodn = ";Len(mas)
?" razmer_upak = ";Len(mas2)
?:?" SRAVNENIE=";
If mas=mas3 Then ?"DA" Else ?"NET"
Sleep
Пример сжатия файла (памяти):
Код
#Include "file.bi"
#Include "lzg.bas" ' Сжатие Участка Памяти
Var file = "file.txt"
var ff = FreeFile
Dim As ULong i, razmer, razm, razmer2
Dim As UByte Ptr mas,ms,mas2
If FileExists(file) = 0 Then ?"No File for Compress!":Sleep:End
Open file For Binary Access Read As ff
razmer = Lof(ff)
If razmer Then
mas = Allocate(razmer)
Get #ff,,*mas,razmer
Else
?"No Data for Compress!":Sleep:End
EndIf
Close ff
Var tm = Timer
?:?" Upakovka = "; ' упаковка
razm = LzgCompress(mas,razmer,ms):?Using "##.### sek";(Timer-tm):tm = Timer
?" Raspakovka = "; ' распаковка
razmer2 = LzgDecompress(ms, razm, mas2):?Using "##.### sek";(Timer-tm)
?:? " Razmer Ishodn = ";razmer
?" Razmer Upak = ";razm
?:?" SRAVNENIE = "; ' сравниваем распакованный и исходный массивы
If razmer = razmer2 Then
For i = 0 To razmer-1
If mas [i]<> mas2 [i]Then Exit For
Next
EndIf
If i = razmer Then ?"DA" Else ?"NET"
ff = FreeFile
Open file & ".lzg" For Binary Access write Lock write As ff
Put #ff,,*ms,razm ' записываем упакованный массив в файл
Close ff
DeAllocate mas ' удаляем исходный массив
DeAllocate ms ' удаляем сжатые данные
DeAllocate mas2 ' удаляем распакованный массив
Sleep
