var
a,k: byte;
Begin
WriteInFile(buffer);
If length(buffer)>=8
Then
ShowMessage('ошибка в вычислении буфера')
Else
If Length(buffer)<>0
Then
Begin
a:=$FF;
for k:=1 to Length(buffer) do
If buffer[k]='0'
Then
a:=a xor (1 shl (8-k));
BlockWrite(FileToWrite,a,1);
End;
End;
Type
Integer_=Array [1..4] of Byte;
//перевод целого числа в массив из четырех байт.
Procedure IntegerToByte(i: Integer; var mass: Integer_);
var
a: Integer;
b: ^Integer_;
Begin
b:=@a;
a:=i;
mass:=b^;
End;
//перевод массива из четырех байт в целое число.
Procedure ByteToInteger(mass: Integer_; var i: Integer);
var
a: ^Integer;
b: Integer_;
Begin
a:=@b;
b:=mass;
i:=a^;
End;
//процедура создания заголовка архива
Procedure CreateHead;
var
b: Integer_;
//a: Integer;
i: Byte;
Begin
//Размер несжатого файла
IntegerToByte(MainFile.Size,b);
BlockWrite(FileToWrite,b,4);
//Количество оригинальных байт
BlockWrite(FileToWrite,MainFile.Stat.CountByte,1);
//Байты со статистикой
For i:=0 to MainFile.Stat.CountByte do
Begin
BlockWrite(FileToWrite,MainFile.Stat.massiv[i]^.Symbol,1);
IntegerToByte(MainFile.Stat.massiv[i]^.SymbolStat,b);
BlockWrite(FileToWrite,b,4);
End;
End;
const
MaxCount=4096;
type
buffer_=object
ArrOfByte: Array [1..MaxCount] of Byte;
ByteCount: Integer;
GeneralCount: Integer;
Procedure CreateBuf;
Procedure InsertByte(a: Byte);
Procedure FlushBuf;
End;
/////////////////////////////
Procedure buffer_.CreateBuf;
Begin
ByteCount:=0;
GeneralCount:=0;
End;
////////////////////////////////////////
Procedure buffer_.InsertByte(a: Byte); //в а передаём уже
// раскодированный символ котрый надо записать в файл
Begin
if GeneralCount<MainFile.Size
Then
Begin
inc(ByteCount);
inc(GeneralCount);
ArrOfByte[ByteCount]:=a;
//////////////////////////
if ByteCount=MaxCount
Then
Begin
BlockWrite(FileToWrite,ArrOfByte,ByteCount);
ByteCount:=0;
End;
End;
End;
////////////////////////////
Procedure Buffer_.FlushBuf; //сброс буфера
Begin
If ByteCount<>0
Then
BlockWrite(FileToWrite,ArrOfByte,ByteCount);
End;
//создание деархивированного файла
Procedure CreateDeArc;
var
i,j: Integer;
k: Byte;
//////////////
Buf: Array [1..Count] of Byte;
CountBuf, LastBuf: Integer;
MainBuffer: buffer_;
BufSearch:string;
{Процедура поиска символа, кторый соотвествуеткодовому слову которое передаётся вызывающей функцией как параметр.
Алгоритм: Вызывающая ф-ия CreateDeArc вырабатывает значение символа из разархивируемого файла и вызывает ф-ию SearchSymbol (Str:string); с параметром Str в котором находится выработанны символ. Ф-ия SearchSymbol прибавляет этот символ к строке Str1 в которой формируется кодовое слово}
Procedure SearchSymbol (Str:string);
var
v:integer;
SearchStr:String;//вспомогательная переменная в которую
//загоняются кодовые слова для сравнения их с Str1
a:byte;//переменная в которой будет находится найденный
//символ
begin
Str1:=Str1+Str;//растим кодовое слово
For v:=0 to MainFile.Stat.CountByte do
begin //производим поиск в массиве
SearchStr:=MainFile.Stat.massiv[v]^.CodWord ;
If (SearchStr=Str1) Then
begin
//если нашли то в а загоняем значение символа
a:=MainFile.Stat.massiv[v]^.Symbol;
//вызываем процедуру записи символа
MainBuffer.InsertByte(a);
//обнуляем строковую переменную
Str1:='';
//выходим из цикла
Break;
end;
end;
end;
Begin
BufSearch:='';{переменная в которой хранится выработанный символ, который будет передаватся в процедуру SearchSymbol}
CountBuf:=MainFile.FileSizeWOHead div count;
LastBuf:=MainFile.FileSizeWOHead mod count;
MainBuffer.CreateBuf;
For i:=1 to CountBuf do
Begin
BlockRead(FileToRead,buf,count);
for j:=1 to Count do
Begin
{Выделяем байт в массиве. По циклу от 1 до 8 просматриваем значения его бит c 8 до 1. Для этого используется операция битового сдвига влево shl и логиеская операция and.
В цикле всё происходит следующим образом: Сначала просматривается старший бит (8-к)=7 и производится логическая операция and, если бит равен 1 то (1 and 1)=1 и в BufSearch:='1', если же бит равен 0 и (0 and 1)=0 и в BufSearch:='1' }
for k:=1 to 8 do
Begin
If ((Buf[j] and (1 shl (8-k)))<>0 ) Then
begin
BufSearch:='1';
//вызываем процедуру SearchSymbol
SearchSymbol (BufSearch);
//обнуляем поисковую переменную
BufSearch:='';
end
Else
begin
BufSearch:=BufSearch+'0';
SearchSymbol (BufSearch);
BufSearch:='';
Application.ProcessMessages;
End;
Application.ProcessMessages;
End;
Application.ProcessMessages;
End;
Application.ProcessMessages;
End;
If LastBuf<>0
Then //аналогично вышесказанному
Begin
BlockRead(FileToRead,Buf,LastBuf);
for j:=1 to LastBuf do
Begin
for k:=1 to 8 do
Begin
If ((Buf[j] and (1 shl (8-k)))<>0 )
Then
begin
BufSearch:=BufSearch+'1';
SearchSymbol (BufSearch);
BufSearch:='';
end
Else
begin
BufSearch:=BufSearch+'0';
SearchSymbol (BufSearch);
BufSearch:='';
end;
Application.ProcessMessages;
End;
Application.ProcessMessages;
End;
End;
MainBuffer.FlushBuf;
End;
//процедура чтения заголовка архива
Procedure ReadHead;
var
b: Integer_;
SymbolSt: Integer;
count_, SymbolId, i: Byte;
Begin
try
//узнаем исходный размер файла
BlockRead(FileToRead,b,4);
ByteToInteger(b,MainFile.size);
//узнаем количество оригинальных байтов
BlockRead(FileToRead,count_,1);
{}{}{}
MainFile.Stat.create;
MainFile.Stat.CountByte:=count_;
//загоняем частоты в массив
for i:=0 to MainFile.Stat.CountByte do
Begin
BlockRead(FileToRead,SymbolId,1);
MainFile.Stat.massiv[i]^.Symbol:=SymbolId;
BlockRead(FileToRead,b,4);
ByteToInteger(b,SymbolSt);
MainFile.Stat.massiv[i]^.SymbolStat:=SymbolSt;
End;
CreateTree(MainFile.Tree,MainFile.stat.massiv,MainFile.Stat.CountByte);
/////////////
CreateDeArc;
//////////////
// DeleteTree(MainFile.Tree);
except
ShowMessage('архив испорчен!');
End;
End;
//процедура извлечения архива
Procedure ExtractFile;
Begin
AssignFile(FileToRead,MainFile.Name);
AssignFile(FileToWrite,MainFile.DeArcName);
try
Reset(FileToRead,1);
Rewrite(FileToWrite,1);
//процедура чтения шапки файла
ReadHead;
Closefile(FileToRead);
Closefile(FileToWrite);
Except
ShowMessage('Ошибка распаковки файла');
End;
End;
//вспомогательная процедура для создания архива
Procedure CreateArchiv;
var
buffer: String;
ArrOfStr: Array [0..255] of String;
i,j: Integer;
//////////////
buf: Array [1..count] of Byte;
CountBuf, LastBuf: Integer;
Begin
Application.ProcessMessages;
AssignFile(FileToRead,MainFile.Name);
AssignFile(FileToWrite,MainFile.ArcName);
Try
Reset(FileToRead,1);
Rewrite(FileToWrite,1);
For i:=0 to 255 Do ArrOfStr[i]:='';
For i:=0 to MainFile.Stat.CountByte do
Begin
ArrOfStr[MainFile.Stat.massiv[i]^.Symbol]:=
MainFile.Stat.massiv[i]^.CodWord;
Application.ProcessMessages;
End;
CountBuf:=MainFile.Size div Count;
LastBuf:=MainFile.Size mod Count;
Buffer:='';
/////////////
CreateHead;
/////////////
for i:=1 to countbuf do
Begin
BlockRead(FileToRead,buf,Count);
//////////////////////
For j:=1 to count do
Begin
buffer:=buffer+ArrOfStr[buf[j]];
If Length(buffer)>8*count
Then
WriteInFile(buffer);
Application.ProcessMessages;
End;
End;
If lastbuf<>0
Then
Begin
BlockRead(FileToRead,buf,LastBuf);
For j:=1 to lastbuf do
Begin
buffer:=buffer+ArrOfStr[buf[j]];
If Length(buffer)>8*count
Then
WriteInFile(buffer);
Application.ProcessMessages;
End;
End;
WriteInFile_(buffer);
CloseFile(FileToRead);
CloseFile(FileToWrite);
Except
ShowMessage('Ошибка создания архива');
End;
End;
//главная процедура для создания архивного файла
Procedure CreateFile;
var
i: Byte;
Begin
With MainFile do
Begin
{сортировка массива байтов с частотами}
SortMassiv(Stat.massiv,stat.CountByte);
{поиск числа задействованных байтов из таблицы возмжных символов. В count_byte будем хранить количество этох самых байт }
i:=0;//обнуляем счётчик
While (i<Stat.CountByte) //до тех пор пока счётчик
//меньше количества задействовнных байт CountByte
//и статистика байта (частота появления в файле)
//не равна нулю делаем
and (Stat.massiv[i]^.SymbolStat<>0) do
Begin
Inc(i); //увеличиваем счётчик на единицу
End;
//////////////////////
If Stat.massiv[i]^.SymbolStat=0 //если дошли до символа
//с нулевой встречаемостью в файле то
Then
Dec(i); //уменьшаем счётчик на единицу тоесть возвращаемся
//назад это будет последний элемент
//////////////////////
Stat.CountByte:=i;//присваиваем значение счётчика
//count_byte. Это означает что в архивируемом файле
//используется такое количество из 256 возможных
//символов. Будет исползоватся для построения древа частот
{создание дерева частот.
Передаём в процедуру начальные параметры Tree=nil-эта переменная будет содержать после работы процедуры древо ,Stat.massiv-массив с символами и соответствующей им статистикой,а так же указанием на правое и левой дерево, Stat. CountByte-количество используемых символов в архивирумом файле }
CreateTree(Tree,Stat.massiv,Stat.CountByte);
//пишем сам файл
CreateArchiv;
//Удаляем уже ненужное дерево
//DeleteTree(Tree);
//Инициализируем статистику файла
MainFile.Stat.Create;
End;
End;
procedure RunEncodeShan(FileName_: string);
begin
MainFile.Name:=FileName_;//передаём имя
//архивируемого файла в программу
StatFile(MainFile.Name); //запускем процедуру создания
//статистики (частоты появления того или иного символа)для файла
CreateFile; //вызов процедуры созданя архивного файла
end;
procedure RunDecodeShan(FileName_: string);
begin
MainFile.name:=FileName_;//передаём имя
//архивируемого файла в программу
ExtractFile;//Вызываем процедуру извлечения архива
end;
end.
Приложение 2.
Реализация на Delphi алгоритма сжатия Хафмана
unit Haffman;
interface
Uses
Forms,ComCtrls, Dialogs;
const
Count=4096;
ArchExt='haf';
dot='.';
//две файловые переменные для чтения исходного файла и для
//записи архива
var
FileToRead,FileToWrite: File;
ProgressBar1:TProgressBar;
// Процедуры для работы с файлом
// Первая - кодирование файла
procedure RunEncodeHaff(FileName_: string);
// Вторая - декодирование файла
procedure RunDecodeHaff(FileName_: string);
implementation
Type
{тип элемета для динамической обработки статистики символов
встречающихся в файле}
TByte=^PByte;
PByte=Record
//Символ (один из символв ASCII)
Symbol: Byte;
//частота появления символа в сжимаемом файле
SymbolStat: Integer;
//последовательность битов, в которые преобразуется текущий
//элемент после работы древа (Кодовое слово) (в виде строки из "0" и "1")
CodWord: String;
//ссылки на левое и правое поддеревья (ветки)
left, right: TByte;
End;
{массив из символов со статистикой , т.е. частотой появления их в архивируемом файле}
BytesWithStat = Array [0..255] of TByte;
{объект, включающий в себя:
массив элементов содержащий в себе количество элементов,
встречающихся в файле хотя бы один раз
процедура инициализации объекта
процедура для увеличения частоты i-го элемента}
TStat =Object
massiv: BytesWithStat;
CountByte: byte;
Procedure Create;//процедура инициализации обьекта
Procedure Inc(i: Byte);
End;
// процедура инициализации объекта вызывается из процедуры StatFile
Procedure TStat.Create; //(291)
var
i: Byte;
Begin //создаём массив симолв (ASCII), обнуляем статистику
//и ставим указатели в положение не определено
CountByte:=255;
For i:=0 to CountByte do
Begin
New(massiv[i]);//создаём динамическую переменную