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 біт замінюється серпня +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
Символу CADFBE
| |
+--+--+
+ + - +
| 15 | = 5 + 10
+ - +
Номер в рамці - сума частот символів D і A. Тепер ми знову шукаємо два символи з самими низькими частотами входження. Виключаючи з перегляду D і A і розглядаючи замість них новий "вузол" з сумарною частотою входження. Найнижча частота тепер у F і нового "вузла". Знову зробимо операцію злиття вузлів:
Частота 30 10 5 10 20 25
Символу CADFBE
| | |
| | |
| +--+| |
+ - | 15 + + |
+ + - + |
| |
| + - + |
+----| 25 + - + = 10 + 15
+ - +
Розглядаємо таблицю знову для наступних двох символів (B і E). Ми продовжуємо в цей режим поки все "дерево" не сформовано, тобто поки все не зведеться до одного вузла.
Частота 30 10 5 10 20 25
Символу CADFBE
| | | | | |
| | | | | |
| | +--+| | | |
| + - | 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, так як наступний біт може бути як початком наступного коду, так і продовженням попереднього.
Необхідно додати, що ключем до побудови префіксних кодів звичайне бінарне дерево і якщо уважно розглянути попередній приклад з побудовою дерева, можна переконатися, що всі одержувані коди там префіксний.
Одне останнє примітка - алгоритм Хаффмана вимагає читати вхідний файл двічі, один раз вважаючи частоти входження символів, інший разпроізводя безпосередньо кодування.
PS Про "ключику" дає дорогу алгоритмом 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 CreateComdivssCode;
{--- Обнулення змінних і запуск перегляду дерева з вершини ---}
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; {створення дерева частот}
CreateComdivssCode; {Створення коду стиснення}
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; {створення дерева частот}
CreateComdivssCode;
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.