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;
procedure ResetArchiv;
{
--- открытие файла архива, или его создание --- }
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;
{
--- инициализация таблицы кодировки --- }
Var I : 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
CurPoint^.NewRight^.CounterEnter then
begin
HelpPoint:=CurPoint^.NewRight;
HelpPoint^.NewLeft:=CurPoint^.NewLeft;
CurPoint^.NewLeft:=HelpPoint;
If HelpPoint^.NewRightNil
then HelpPoint^.NewRight^.NewLeft:=CurPoint;
CurPoint^.NewRight:=HelpPoint^.NewRight;
HelpPoint^.NewRight:=CurPoint;
If HelpPoint^.NewLeftNil
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;
function SearchOpenCode : 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
(HelpPointRightRange) then
HelpPoint:=HelpPoint^.NewRight;
end;
If HelpPoint=CurPoint then
SearchOpenCode:=False else SearchOpenCode:=True;
end;
procedure CreateTree;
{
--- создание дерева частот вхождения --- }
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
(HelpPointNil) 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^.NewLeftNil then
Root^.NewLeft^.NewRight:=Root;
end;
end;
end;
procedure ViewTree( P : PCodElement
);
{
--- просмотр дерева частот и присваивание кодировочных цепей листьям --- }
Var Mask,I : word;
begin
Inc(CounterBite);
If P^.P0Nil then ViewTree(
P^.P0 );
If P^.P1Nil 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;
{
--- удаление дерева --- }
Var P : PCodElement;
begin
CurPoint:=LeftRange;
While CurPointNil do
begin
If (CurPoint^.P0Nil) and
(CurPoint^.P1Nil) 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 = ( $56, $53,
$31, $00, $00, $00, $00 );
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,$00,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;
procedure PakOneByte;
{
--- сжатие и пересылка в выходной буфер одного байта --- }
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 CounterBite0 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 (NumRead0) 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
);
{
--- распаковка одного байта --- }
Var Mask : 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.
Список литературы
Для
подготовки данной работы были использованы материалы с сайта http://www.hostmake.ru/