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 різних символів в
собі
. Ми підрахували входження кожного із символів у файл і отримали
наступне
:
+-----------------+-----+-----+-----+-----+---- -+-----+
|
Символ | A | B | C | D | E | F |
+-----------------+-----+-----+-----+-----+---- -+-----|
|
число входжень | 10 | 20 | 30 | 5 | 25 | 10 |
+-----------------+-----+-----+-----+-----+---- -+-----+
Тепер
ми беремо ці числа і будемо називати їх частотою входження для кожного символу.
Розмістимо таблицю як нижче.
+-----------------+-----+-----+-----+-----+---- -+-----+
|
Символ | 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 <
Root ^. CounterEnter) and
(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; (сортування за зростанням
числа входжень)
SaveBufHeader; (зберегти
заголовок архіву в буфері)
SaveBufFATInfo; (зберігається
FAT інформація по файлу
)
SaveBufCodeArray; (зберегти
масив частот входжень в архівному файлі)
CreateTree; (створення дерева
частот)
CreateCompressCode; (Створення коду стиснення)
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/
