Delphi. Немного относительно методов упаковки данных

Running – Это самый простой из методов упаковки информации. Предположите что Вы имеете строку текста, и в конце строки стоит 40 пробелов. Налицо явная избыточность имеющейся информации. Проблема сжатия этой строки решается очень просто – эти 40 пробелов ( 40 байт ) сжимаются в 3 байта с помощью упаковки их по методу повторяющихся символов (running). Первый байт, стоящий вместо 40 пробелов в сжатой строке, фактически будет явлться пробелом ( последовательность была из пробелов ) . Второй байт – специальный байт “флажка” который указывает что мы должны развернуть предыдущий в строке байт в последовательность при восстановлении строки. Третий байт – байт счета ( в нашем случае это будет 40 ). Как Вы сами можете видеть, достаточно чтобы любой раз, когда мы имеем последовательность из более 3-х одинаковых символов, заменять их выше описанной последовательностью, чтобы на выходе получить блок информации меньший по размеру, но допускающий восстановление информации в исходном виде.

Оставляя все сказанное выше истинным, добавлю лишь то, что в данном методе основной проблемой является выбор того самого байта “флажка”, так как в реальных блоках информации как правило используются все 256 вариантов байта и нет возможности иметь 257 вариант – “флажок”. На первый взгляд эта проблема кажется неразрешимой, но к ней есть ключик, который Вы найдете прочитав о кодировании с помощью алгоритма Хаффмана ( Huffman ).

LZW – История этого алгоритма начинается с опубликования в мае 1977 г. Дж. Зивом ( J. Ziv ) и А. Лемпелем ( A. Lempel ) статьи в журнале “Информационные теории ” под названием ” IEEE Trans “. В последствии этот алгоритм был доработан Терри А. Велчем ( Terry A. Welch ) и в окончательном варианте отражен в статье ” IEEE Compute ” в июне 1984 . В этой статье описывались подробности алгоритма и некоторые общие проблемы с которыми можно

Столкнуться при его реализации. Позже этот алгоритм получил название – LZW (Lempel – Ziv – Welch) .

Алгоритм LZW представляет собой алгоритм кодирования последовательностей неодинаковых символов. Возьмем для примера строку ” Объект TSortedCollection порожден от TCollection.”. Анализируя эту строку мы можем видеть, что слово “Collection” повторяется дважды. В этом слове 10 символов – 80 бит. И если мы сможем заменить это слово в выходном файле, во втором его включении, на ссылку на первое включение, то получим сжатие информации. Если рассматривать входной блок информации размером не более 64К и ограничится длинной кодируемой строки в 256 символов, то учитывая байт “флаг” получим, что строка из 80 бит заменяется 8+16+8 = 32 бита. Алгоритм LZW как-бы “обучается” в процессе сжатия файла. Если существуют повторяющиеся строки в файле, то они будут закодированны в таблицу. Очевидным преимуществом алгоритма является то, что нет необходимости включать таблицу кодировки в сжатый файл. Другой важной особенностью является то, что сжатие по алгоритму LZW является однопроходной операцией в противоположность алгоритму Хаффмана ( Huffman ) , которому требуется два прохода.

Huffman – Сначала кажется что создание файла меньших размеров из исходного без кодировки последовательностей или исключения повтора байтов будет невозможной задачей. Но давайте мы заставим себя сделать несколько умственных усилий и понять алгоритм Хаффмана ( Huffman ). Потеряв не так много времени мы приобретем знания и дополнительное место на дисках.

Сжимая файл по алгоритму Хаффмана первое что мы должны сделать – это необходимо прочитать файл полностью и подсчитать сколько раз встречается каждый символ из расширенного набора ASCII. Если мы будем учитывать все 256 символов, то для нас не будет разницы в сжатии текстового и EXE файла.

После подсчета частоты вхождения каждого символа, необходимо просмотреть таблицу кодов ASCII и сформировать мнимую компоновку между кодами по убыванию. То есть не меняя местонахождение каждого символа из таблицы в памяти отсортировать таблицу ссылок на них по убыванию. Каждую ссылку из последней таблицы назовем “узлом”. В дальнейшем ( в дереве ) мы будем позже размещать указатели которые будут указывает на этот “узел”. Для ясности давайте рассмотрим пример:

Мы имеем файл длинной в 100 байт и имеющий 6 различных символов в

Себе. Мы подсчитали вхождение каждого из символов в файл и получили

Следующее :

+—————–+—–+—–+—–+—–+—–+—–+

| cимвол | A | B | C | D | E | F |

+—————–+—–+—–+—–+—–+—–+—–|

| число вхождений | 10 | 20 | 30 | 5 | 25 | 10 |

+—————–+—–+—–+—–+—–+—–+—–+

Теперь мы берем эти числа и будем называть их частотой вхождения для каждого символа. Разместим таблицу как ниже.

+—————–+—–+—–+—–+—–+—–+—–+

| cимвол | C | E | B | F | A | D |

+—————–+—–+—–+—–+—–+—–+—–|

| число вхождений | 30 | 25 | 20 | 10 | 10 | 5 |

+—————–+—–+—–+—–+—–+—–+—–+

Мы возьмем из последней таблицы символы с наименьшей частотой. В нашем случае это D (5) и какой либо символ из F или A (10), можно взять любой из них например A. Сформируем из “узлов” D и A новый “узел”, частота вхождения для которого будет равна сумме частот D и A :

Частота 30 10 5 10 20 25

Символа C A D F B E

| |

+–+–+

++-+

|15| = 5 + 10

+–+

Номер в рамке – сумма частот символов D и A. Теперь мы снова ищем два символа с самыми низкими частотами вхождения. Исключая из просмотра D и A и рассматривая вместо них новый “узел” с суммарной частотой вхождения. Самая низкая частота теперь у F и нового “узла”. Снова сделаем операцию слияния узлов :

Частота 30 10 5 10 20 25

Символа C A D F B E

| | |

| | |

| +–+| |

+-|15++ |

++-+ |

| |

| +–+ |

+—-|25+-+ = 10 + 15

+–+

Рассматриваем таблицу снова для следующих двух символов ( B и E ). Мы продолжаем в этот режим пока все “дерево” не сформировано, т. е. пока все не сведется к одному узлу.

Частота 30 10 5 10 20 25

Символа C A D F B E

| | | | | |

| | | | | |

| | +–+| | | |

| +-|15++ | | |

| ++-+ | | |

| | | | |

| | +–+ | | +–+ |

| +—-|25+-+ +-|45+-+

| ++-+ ++-+

| +–+ | |

+—-|55+——+ |

+-++ |

| +————+ |

+—| Root (100) +—-+

+————+

Теперь когда наше дерево создано, мы можем кодировать файл. Мы должны всегда начинать из корня ( Root ) . Кодируя первый символ (лист дерева С) Мы прослеживаем вверх по дереву все повороты ветвей и если мы делаем левый поворот, то запоминаем 0-й бит, и аналогично 1-й бит для правого поворота. Так для C, мы будем идти влево к 55 ( и запомним 0 ), затем снова влево (0) к самому символу. Код Хаффмана для нашего символа C – 00. Для следующего символа ( А ) у нас получается – лево, право, лево, лево, что выливается в последовательность 0100. Выполнив выше сказанное для всех символов получим

C = 00 ( 2 бита )

A = 0100 ( 4 бита )

D = 0101 ( 4 бита )

F = 011 ( 3 бита )

B = 10 ( 2 бита )

E = 11 ( 2 бита )

Каждый символ изначально представлялся 8-ю битами ( один байт ), и так как мы уменьшили число битов необходимых для представления каждого символа, мы следовательно уменьшили размер выходного файла. Сжатие складывется следующим образом :

+———-+—————-+——————-+————–+

| Частота | первоначально | уплотненные биты | уменьшено на |

+———-+—————-+——————-+————–|

| C 30 | 30 x 8 = 240 | 30 x 2 = 60 | 180 |

| A 10 | 10 x 8 = 80 | 10 x 3 = 30 | 50 |

| D 5 | 5 x 8 = 40 | 5 x 4 = 20 | 20 |

| F 10 | 10 x 8 = 80 | 10 x 4 = 40 | 40 |

| B 20 | 20 x 8 = 160 | 20 x 2 = 40 | 120 |

| E 25 | 25 x 8 = 200 | 25 x 2 = 50 | 150 |

+———-+—————-+——————-+————–+

Первоначальный размер файла : 100 байт – 800 бит;

Размер сжатого файла : 30 байт – 240 бит;

240 – 30% из 800 , так что мы сжали этот файл на 70%.

Все это довольно хорошо, но неприятность находится в том факте, что для восстановления первоначального файла, мы должны иметь декодирующее дерево, так как деревья будут различны для разных файлов. Следовательно мы должны сохранять дерево вместе с файлом. Это превращается в итоге в увеличение размеров выходного файла.

В нашей методике сжатия и каждом узле находятся 4 байта указателя, по этому, полная таблица для 256 байт будет приблизительно 1 Кбайт длинной. Таблица в нашем примере имеет 5 узлов плюс 6 вершин ( где и находятся наши символы ) , всего 11 . 4 байта 11 раз – 44 . Если мы добавим после небольшое количество байтов для сохранения места узла и некоторую другую статистику – наша таблица будет приблизительно 50 байтов длинны. Добавив к 30 байтам сжатой информации, 50 байтов таблицы получаем, что общая длинна архивного файла вырастет до 80 байт. Учитывая, что первоначальная длинна файла в рассматриваемом примере была 100 байт – мы получили 20% сжатие информации. Не плохо. То что мы действительно выполнили – трансляция символьного ASCII набора в наш новый набор требующий меньшее количество знаков по сравнению с стандартным.

Что мы можем получить на этом пути?

Рассмотрим максимум которй мы можем получить для различных разрядных комбинацй в оптимальном дереве, которое является несимметричным.

Мы получим что можно иметь только :

4 – 2 разрядных кода;

8 – 3 разрядных кодов;

16 – 4 разрядных кодов;

32 – 5 разрядных кодов;

64 – 6 разрядных кодов;

128 – 7 разрядных кодов;

Необходимо еще два 8 разрядных кода.

4 – 2 разрядных кода;

8 – 3 разрядных кодов;

16 – 4 разрядных кодов;

32 – 5 разрядных кодов;

64 – 6 разрядных кодов;

128 – 7 разрядных кодов;

——–

254

Итак мы имеем итог из 256 различных комбинаций которыми можно кодировать байт. Из этих комбинаций лишь 2 по длинне равны 8 битам. Если мы сложим число битов которые это представляет, то в итоге получим 1554 бит или 195 байтов. Так в максимуме, мы сжали 256 байт к 195 или 33%, таким образом максимально идеализированный Huffman может достигать сжатия в 33% когда используется на уровне байта Все эти подсчеты производились для не префиксных кодов Хаффмана т. е. кодов, которые нельзя идентифицировать однозначно. Например код A – 01011 и код B – 0101 . Если мы будем получать эти коды побитно, то получив биты 0101 мы не сможем сказать какой код мы получили A или B, так как следующий бит может быть как началом следующего кода, так и продолжением предыдущего.

Необходимо добавить, что ключем к построению префиксных кодов служит обычное бинарное дерево и если внимательно рассмотреть предыдущий пример с построением дерева, можно убедится, что все получаемые коды там префиксные.

Одно последнее примечание – алгоритм Хаффмана требует читать входной файл дважды, один раз считая частоты вхождения символов, другой разпроизводя непосредственно кодирование.

P. S. О “ключике” дающем дорогу алгоритму Running.

—- Прочитав обзорную информацию о Huffman кодировании подумайтенад тем, что на нашем бинарном дереве может быть и 257 листиков.

Список литературы

1) Описание архиватора Narc фирмы Infinity Design Concepts, Inc.;

2) Чарльз Сейтер, ‘Сжатие данных’, “Мир ПК”, N2 1991;

Приложение

{$A+,B-,D+,E+,F-,G-,I-,L+,N-,O-,R+,S+,V+,X-}

{$M 16384,0,655360}

{******************************************************}

{* Алгоритм уплотнения данных по методу *}

{* Хафмана. *}

{******************************************************}

Program Hafman;

Uses Crt, Dos, Printer;

Type PCodElement = ^CodElement;

CodElement = record

NewLeft, NewRight,

P0, P1 : PCodElement; {элемент входящий одновременно}

LengthBiteChain : byte; { в массив, очередь и дерево }

BiteChain : word;

CounterEnter : word;

Key : boolean;

Index : byte;

End;

TCodeTable = array [0..255] of PCodElement;

Var CurPoint, HelpPoint,

LeftRange, RightRange : PCodElement;

CodeTable : TCodeTable;

Root : PCodElement;

InputF, OutputF, InterF : file;

TimeUnPakFile : longint;

AttrUnPakFile : word;

NumRead, NumWritten: Word;

InBuf : array[0..10239] of byte;

OutBuf : array[0..10239] of byte;

BiteChain : word;

CRC,

CounterBite : byte;

OutCounter : word;

InCounter : word;

OutWord : word;

St : string;

LengthOutFile, LengthArcFile : longint;

Create : boolean;

NormalWork : boolean;

ErrorByte : byte;

DeleteFile : boolean;

{————————————————-}

Procedure ErrorMessage;

{ — выводсообщенияобошибке — }

Begin

If ErrorByte <> 0 then

Begin

Case ErrorByte of

2 : Writeln(‘File not found…’);

3 : Writeln(‘Path not found…’);

5 : Writeln(‘Access denied…’);

6 : Writeln(‘Invalid handle…’);

8 : Writeln(‘Not enough memory…’);

10 : Writeln(‘Invalid environment…’);

11 : Writeln(‘Invalid format…’);

18 : Writeln(‘No more files…’);

Else Writeln(‘Error #’,ErrorByte,’ …’);

End;

NormalWork:=False;

ErrorByte:=0;

End;

End;

Procedure ResetFile;

{ — открытиефайладляархивации — }

Var St : string;

Begin

Assign(InputF, ParamStr(3));

Reset(InputF, 1);

ErrorByte:=IOResult;

ErrorMessage;

If NormalWork then Writeln(‘Pak file : ‘,ParamStr(3),’…’);

End;

ProcedureResetArchiv;

{ — открытие файла архива, или его создание — }

Begin

St:=ParamStr(2);

If Pos(‘.’,St)<>0 then Delete(St, Pos(‘.’,St),4);

St:=St+’.vsg’;

Assign(OutputF, St);

Reset(OutPutF,1);

Create:=False;

If IOResult=2 then

Begin

Rewrite(OutputF, 1);

Create:=True;

End;

If NormalWork then

If Create then Writeln(‘Create archiv : ‘,St,’…’)

Else Writeln(‘Open archiv : ‘,St,’…’)

End;

Procedure SearchNameInArchiv;

{ — вдальнейшем – поискименифайлавархиве — }

Begin

Seek(OutputF, FileSize(OutputF));

ErrorByte:=IOResult;

ErrorMessage;

End;

Procedure DisposeCodeTable;

{ — уничтожение кодовой таблицы и очереди — }

Var I : byte;

Begin

For I:=0 to 255 do Dispose(CodeTable[I]);

End;

Procedure ClosePakFile;

{ — закрытиеархивируемогофайла — }

Var I : byte;

Begin

If DeleteFile then Erase(InputF);

Close(InputF);

End;

Procedure CloseArchiv;

{ — закрытиеархивногофайла — }

Begin

If FileSize(OutputF)=0 then Erase(OutputF);

Close(OutputF);

End;

Procedure InitCodeTable;

{ — инициализация таблицы кодировки — }

VarI : byte;

Begin

For I:=0 to 255 do

Begin

New(CurPoint);

CodeTable[I]:=CurPoint;

With CodeTable[I]^ do

Begin

P0:=Nil;

P1:=Nil;

LengthBiteChain:=0;

BiteChain:=0;

CounterEnter:=1;

Key:=True;

Index:=I;

End;

End;

For I:=0 to 255 do

Begin

If I>0 then CodeTable[I-1]^.NewRight:=CodeTable[I];

If I<255 then CodeTable[I+1]^.NewLeft:=CodeTable[I];

End;

LeftRange:=CodeTable[0];

RightRange:=CodeTable[255];

CodeTable[0]^.NewLeft:=Nil;

CodeTable[255]^.NewRight:=Nil;

End;

ProcedureSortQueueByte;

{ — пузырьковая сортировка по возрастанию — }

Var Pr1,Pr2 : PCodElement;

Begin

CurPoint:=LeftRange;

While CurPoint <> RightRange do

Begin

If CurPoint^.CounterEnter > CurPoint^.NewRight^.CounterEnter then

Begin

HelpPoint:=CurPoint^.NewRight;

HelpPoint^.NewLeft:=CurPoint^.NewLeft;

CurPoint^.NewLeft:=HelpPoint;

If HelpPoint^.NewRight<>Nil then HelpPoint^.NewRight^.NewLeft:=CurPoint;

CurPoint^.NewRight:=HelpPoint^.NewRight;

HelpPoint^.NewRight:=CurPoint;

If HelpPoint^.NewLeft<>Nil then HelpPoint^.NewLeft^.NewRight:=HelpPoint;

If CurPoint=LeftRange then LeftRange:=HelpPoint;

If HelpPoint=RightRange then RightRange:=CurPoint;

CurPoint:=CurPoint^.NewLeft;

If CurPoint = LeftRange then CurPoint:=CurPoint^.NewRight

Else CurPoint:=CurPoint^.NewLeft;

End

Else CurPoint:=CurPoint^.NewRight;

End;

End;

Procedure CounterNumberEnter;

{ — подсчетчастотвхожденийбайтоввблоке — }

Var C : word;

Begin

For C:=0 to NumRead-1 do

Inc(CodeTable[(InBuf[C])]^.CounterEnter);

End;

FunctionSearchOpenCode : boolean;

{ — поиск в очереди пары открытых по Key минимальных значений — }

Begin

CurPoint:=LeftRange;

HelpPoint:=LeftRange;

HelpPoint:=HelpPoint^.NewRight;

While not CurPoint^.Key do

CurPoint:=CurPoint^.NewRight;

While (not (HelpPoint=RightRange)) and (not HelpPoint^.Key) do

Begin

HelpPoint:=HelpPoint^.NewRight;

If (HelpPoint=CurPoint) and (HelpPoint<>RightRange) then

HelpPoint:=HelpPoint^.NewRight;

End;

If HelpPoint=CurPoint then SearchOpenCode:=False else SearchOpenCode:=True;

End;

ProcedureCreateTree;

{ — создание дерева частот вхождения — }

Begin

While SearchOpenCode do

Begin

New(Root);

With Root^ do

Begin

P0:=CurPoint;

P1:=HelpPoint;

LengthBiteChain:=0;

BiteChain:=0;

CounterEnter:=P0^.CounterEnter + P1^.CounterEnter;

Key:=True;

P0^.Key:=False;

P1^.Key:=False;

End;

HelpPoint:=LeftRange;

While (HelpPoint^.CounterEnter < Root^.CounterEnter) and

(HelpPoint<>Nil) do HelpPoint:=HelpPoint^.NewRight;

If HelpPoint=Nil then { добавлениевконец }

Begin

Root^.NewLeft:=RightRange;

RightRange^.NewRight:=Root;

Root^.NewRight:=Nil;

RightRange:=Root;

End

Else

Begin { вставкаперед HelpPoint }

Root^.NewLeft:=HelpPoint^.NewLeft;

HelpPoint^.NewLeft:=Root;

Root^.NewRight:=HelpPoint;

If Root^.NewLeft<>Nil then Root^.NewLeft^.NewRight:=Root;

End;

End;

End;

Procedure ViewTree( P : PCodElement );

{ — просмотр дерева частот и присваивание кодировочных цепей листьям — }

Var Mask, I : word;

Begin

Inc(CounterBite);

If P^.P0<>Nil then ViewTree( P^.P0 );

If P^.P1<>Nil then

Begin

Mask:=(1 SHL (16-CounterBite));

BiteChain:=BiteChain OR Mask;

ViewTree( P^.P1 );

Mask:=(1 SHL (16-CounterBite));

BiteChain:=BiteChain XOR Mask;

End;

If (P^.P0=Nil) and (P^.P1=Nil) then

Begin

P^.BiteChain:=BiteChain;

P^.LengthBiteChain:=CounterBite-1;

End;

Dec(CounterBite);

End;

Procedure CreateCompressCode;

{ — обнуление переменных и запуск просмотра дерева с вершины — }

Begin

BiteChain:=0;

CounterBite:=0;

Root^.Key:=False;

ViewTree(Root);

End;

Procedure DeleteTree;

{ — удаление дерева — }

VarP : PCodElement;

Begin

CurPoint:=LeftRange;

While CurPoint<>Nil do

Begin

If (CurPoint^.P0<>Nil) and (CurPoint^.P1<>Nil) then

Begin

If CurPoint^.NewLeft <> Nil then

CurPoint^.NewLeft^.NewRight:=CurPoint^.NewRight;

If CurPoint^.NewRight <> Nil then

CurPoint^.NewRight^.NewLeft:=CurPoint^.NewLeft;

If CurPoint=LeftRange then LeftRange:=CurPoint^.NewRight;

If CurPoint=RightRange then RightRange:=CurPoint^.NewLeft;

P:=CurPoint;

CurPoint:=P^.NewRight;

Dispose(P);

End

Else CurPoint:=CurPoint^.NewRight;

End;

End;

Procedure SaveBufHeader;

{ — записьвбуферзаголовкаархива — }

Type

ByteField = array[0..6] of byte;

Const

Header : ByteField = ( , , , {prjdata}, {prjdata}, {prjdata}, {prjdata} );

Begin

If Create then

Begin

Move(Header, OutBuf[0],7);

OutCounter:=7;

End

Else

Begin

Move(Header[3],OutBuf[0],4);

OutCounter:=4;

End;

End;

Procedure SaveBufFATInfo;

{ — запись в буфер всей информации по файлу — }

Var I : byte;

St : PathStr;

R : SearchRec;

Begin

St:=ParamStr(3);

For I:=0 to Length(St)+1 do

Begin

OutBuf[OutCounter]:=byte(Ord(St[I]));

Inc(OutCounter);

End;

FindFirst(St,{prjdata},R);

Dec(OutCounter);

Move(R. Time, OutBuf[OutCounter],4);

OutCounter:=OutCounter+4;

OutBuf[OutCounter]:=R. Attr;

Move(R. Size, OutBuf[OutCounter+1],4);

OutCounter:=OutCounter+5;

End;

Procedure SaveBufCodeArray;

{ — сохранить массив частот вхождений в архивном файле — }

Var I : byte;

Begin

For I:=0 to 255 do

Begin

OutBuf[OutCounter]:=Hi(CodeTable[I]^.CounterEnter);

Inc(OutCounter);

OutBuf[OutCounter]:=Lo(CodeTable[I]^.CounterEnter);

Inc(OutCounter);

End;

End;

Procedure CreateCodeArchiv;

{ — создание кода сжатия — }

Begin

InitCodeTable; { инициализация кодовой таблицы }

CounterNumberEnter; { подсчет числа вхождений байт в блок }

SortQueueByte; { cортировка по возрастанию числа вхождений }

SaveBufHeader; { сохранить заголовок архива в буфере }

SaveBufFATInfo; { сохраняется FAT информация по файлу }

SaveBufCodeArray; { сохранить массив частот вхождений в архивном файле }

CreateTree; { создание дерева частот }

CreateCompressCode; { cоздание кода сжатия }

DeleteTree; { удаление дерева частот }

End;

ProcedurePakOneByte;

{ — сжатие и пересылка в выходной буфер одного байта — }

Var Mask : word;

Tail : boolean;

Begin

CRC:=CRC XOR InBuf[InCounter];

Mask:=CodeTable[InBuf[InCounter]]^.BiteChain SHR CounterBite;

OutWord:=OutWord OR Mask;

CounterBite:=CounterBite+CodeTable[InBuf[InCounter]]^.LengthBiteChain;

If CounterBite>15 then Tail:=True else Tail:=False;

While CounterBite>7 do

Begin

OutBuf[OutCounter]:=Hi(OutWord);

Inc(OutCounter);

If OutCounter=(SizeOf(OutBuf)-4) then

Begin

BlockWrite(OutputF, OutBuf, OutCounter, NumWritten);

OutCounter:=0;

End;

CounterBite:=CounterBite-8;

If CounterBite<>0 then OutWord:=OutWord SHL 8 else OutWord:=0;

End;

If Tail then

Begin

Mask:=CodeTable[InBuf[InCounter]]^.BiteChain SHL

(CodeTable[InBuf[InCounter]]^.LengthBiteChain-CounterBite);

OutWord:=OutWord OR Mask;

End;

Inc(InCounter);

If (InCounter=(SizeOf(InBuf))) or (InCounter=NumRead) then

Begin

InCounter:=0;

BlockRead(InputF, InBuf, SizeOf(InBuf),NumRead);

End;

End;

Procedure PakFile;

{ — процедуранепосредственногосжатияфайла — }

Begin

ResetFile;

SearchNameInArchiv;

If NormalWork then

Begin

BlockRead(InputF, InBuf, SizeOf(InBuf),NumRead);

OutWord:=0;

CounterBite:=0;

OutCounter:=0;

InCounter:=0;

CRC:=0;

CreateCodeArchiv;

While (NumRead<>0) do PakOneByte;

OutBuf[OutCounter]:=Hi(OutWord);

Inc(OutCounter);

OutBuf[OutCounter]:=CRC;

Inc(OutCounter);

BlockWrite(OutputF, OutBuf, OutCounter, NumWritten);

DisposeCodeTable;

ClosePakFile;

End;

End;

Procedure ResetUnPakFiles;

{ — открытие файла для распаковки — }

Begin

InCounter:=7;

St:=”;

Repeat

St[InCounter-7]:=Chr(InBuf[InCounter]);

Inc(InCounter);

Until InCounter=InBuf[7]+8;

Assign(InterF, St);

Rewrite(InterF,1);

ErrorByte:=IOResult;

ErrorMessage;

If NormalWork then

Begin

WriteLn(‘UnPak file : ‘,St,’…’);

Move(InBuf[InCounter],TimeUnPakFile,4);

InCounter:=InCounter+4;

AttrUnPakFile:=InBuf[InCounter];

Inc(InCounter);

Move(InBuf[InCounter],LengthArcFile,4);

InCounter:=InCounter+4;

End;

End;

Procedure CloseUnPakFile;

{ — закрытиефайладляраспаковки — }

Begin

If not NormalWork then Erase(InterF)

Else

Begin

SetFAttr(InterF, AttrUnPakFile);

SetFTime(InterF, TimeUnPakFile);

End;

Close(InterF);

End;

Procedure RestoryCodeTable;

{ — воссозданиекодовойтаблицыпоархивномуфайлу — }

Var I : byte;

Begin

InitCodeTable;

For I:=0 to 255 do

Begin

CodeTable[I]^.CounterEnter:=InBuf[InCounter];

CodeTable[I]^.CounterEnter:=CodeTable[I]^.CounterEnter SHL 8;

Inc(InCounter);

CodeTable[I]^.CounterEnter:=CodeTable[I]^.CounterEnter+InBuf[InCounter];

Inc(InCounter);

End;

End;

Procedure UnPakByte( P : PCodElement );

{ — распаковка одного байта — }

VarMask : word;

Begin

If (P^.P0=Nil) and (P^.P1=Nil) then

Begin

OutBuf[OutCounter]:=P^.Index;

Inc(OutCounter);

Inc(LengthOutFile);

If OutCounter = (SizeOf(OutBuf)-1) then

Begin

BlockWrite(InterF, OutBuf, OutCounter, NumWritten);

OutCounter:=0;

End;

End

Else

Begin

Inc(CounterBite);

If CounterBite=9 then

Begin

Inc(InCounter);

If InCounter = (SizeOf(InBuf)) then

Begin

InCounter:=0;

BlockRead(OutputF, InBuf, SizeOf(InBuf),NumRead);

End;

CounterBite:=1;

End;

Mask:=InBuf[InCounter];

Mask:=Mask SHL (CounterBite-1);

Mask:=Mask OR $FF7F; { установкавсехбитовкроместаршего }

If Mask=$FFFF then UnPakByte(P^.P1)

Else UnPakByte(P^.P0);

End;

End;

Procedure UnPakFile;

{ — распаковкаодногофайла — }

Begin

BlockRead(OutputF, InBuf, SizeOf(InBuf),NumRead);

ErrorByte:=IOResult;

ErrorMessage;

If NormalWork then ResetUnPakFiles;

If NormalWork then

Begin

RestoryCodeTable;

SortQueueByte;

CreateTree; { создание дерева частот }

CreateCompressCode;

CounterBite:=0;

OutCounter:=0;

LengthOutFile:=0;

While LengthOutFile LengthArcFile do

UnPakByte(Root);

BlockWrite(InterF, OutBuf, OutCounter, NumWritten);

DeleteTree;

DisposeCodeTable;

End;

CloseUnPakFile;

End;

{ ————————- main text ————————- }

Begin

DeleteFile:=False;

NormalWork:=True;

ErrorByte:=0;

WriteLn;

WriteLn(‘ArcHaf version 1.0 (c) Copyright VVS Soft Group, 1992.’);

ResetArchiv;

If NormalWork then

Begin

St:=ParamStr(1);

Case St[1] of

‘a’,’A’ : PakFile;

‘m’,’M’ : begin

DeleteFile:=True;

PakFile;

End;

‘e’,’E’ : UnPakFile;

Else ;

End;

End;

CloseArchiv;

End.


Delphi. Немного относительно методов упаковки данных