Курсовая работа: Сжатие данных методами Хафмана и Шеннона-Фано
Try
Reset(f,1);//открываем
файл
MainFile.Stat.create;//вызываем
метод инициализации объекта
//для архивируемого
файла
MainFile.Size:=FileSize(f);//метод
определения размера
// архивируемого файла
///////////////////////
countbuf:=FileSize(f)
div count;//столько целых буферов
//по 4096 байт
содержится в исходном файле
lastbuf:=FileSize(f) mod
count; // остаток (последий буфер)разница
//в байтах до 4096
////////////
For i:=1 to
countbuf do
Begin
BlockRead(f,buf,count);
for j:=1 to
count do
Begin
MainFile.Stat.inc(buf[j]);
Application.ProcessMessages;
End;
Application.ProcessMessages;
End;
/////////////
If lastbuf<>0
//просчитываем статистику для оставшихся
//байт
Then
Begin
BlockRead(f,buf,lastbuf);
for j:=1 to
lastbuf do
Begin
MainFile.Stat.inc(buf[j]);
Application.ProcessMessages;
End;
Application.ProcessMessages;
End;
CloseFile(f);
Except
ShowMessage('ошибка доступа к файлу!')
End;
End;
//процедура записи
сжатого потока битов в архив
Procedure
WriteInFile(var buffer: String);
var
i,j: Integer;
k: Byte;
buf:
Array[1..2*count] of byte;
Begin
i:=Length(buffer) div 8;
// узнаем сколько получится
//байт в каждой
последовательности
//////////////////////////
For j:=1 to i do // работаем
с байтами
Begin
buf[j]:=0;// обнуляем
тот элемент мссива в
//который будем писать
///////////////////////////
For k:=1 to 8 do //работаем
с битами
{находим в строке тот
элемент который будем записывать в виде
последовательности бит (будем просматривать с (j-1) элемента
строки buffer восемь элментов за ним тем самым
сформируется строка из восьми '0' и '1'. Эту строку мы будем
преобразовывать в байт, который должен будет содержать
такуюже последовательность бит)}
Begin
If
buffer[(j-1)*8+k]='1'
Then
{Преобразование будем
производить с помощью операции битового сдвига
влево shl и логической опереоции или (or). Делается это так поверяется условие buffer[(j-1)*8+k]='1' если в выделенной строке из восьми символов (мы просматриваем её по циклу от первого элемента до восьмого), элемент, индекс которого равен счётчику цикла к, равен единице, то к соответствующему биту (номер которого в байте равен переменной цикла к) будет применена операция or (0 or 1=1) т.е. это бит примет значение 1. Если в строке будет ноль то и соответствующий бит будет равен нулю. (нам его не требуется устанавливать т.к. в начале работы с каждым байтом мы его обнуляем)}
buf[j]:=buf[j] or (1 shl
(8-k));
Application.ProcessMessages;
End;
Application.ProcessMessages;
End;
BlockWrite(FileToWrite,buf,i);
Delete(buffer,1,i*8);
End;
//процедура для
окончательной записи остаточной цепочки битов в архив
Procedure
WriteInFile_(var buffer: String);
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);
Страницы: 1, 2, 3, 4, 5, 6, 7, 8 |
