регистрация /  вход

Сжатие данных методами Хафмана и Шеннона-Фано (стр. 6 из 7)

символа то кодовому слову присваиваем строку из '0' }

Then

SymbolToCodWord:='0'

Else {иначе уменьшаем строку на один символ т.е. убираем '+'

признак того что символ найден}

SymbolToCodWord:=Copy(s,1,length(s)-1);

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//работаем с битами

Begin

If buffer[(j-1)*8+k]='1'{находим в строке тот элементкоторый будем записывать в виде последовательности бит(будем просматривать с (j-1) элемента строки buffer восемь элментов за ним тем самым сформируется строка из восьми '0' и '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

{Так как эту процедуру вызывает процедура которая передаёт в буфереотнюдь не один последний байт, то срау вызываем процедуруобычной записи в файл. После работы которой в buffer должнаостася последвательность из не более 8 символов. По этомумы производим проверку и если что то не так то выводим сообщение.

Иначе устанавливаем в переменной а все биты в 1 и далее производимследующие действия: Просматриваем по циклу всё что осталось вbuffer и если найдётся символ '0' то к сответтвующему биту переменной априменяем операцию xor (т.е. 1 xor 1 что даст 0) т.е. оответствующийбит установится в 0 все остальные биты переменной а останутся в том жесостоянии что и были. Оставшиеся биты будут единицами}

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;

//перевод числа типа Integer в массив из четырех байт.

Procedure IntegerToByte(i: Integer; var mass: Integer_);

var

a: Integer;

b: ^Integer_;

Begin

b:=@a;// соединяем адресс переменной а с b

a:=i;//в а перегоняем наше значение типа integer

mass:=b^;{разименовываем b и соединяем результат с massв результате работы этого кода число типа Integerперейд в массив из 4 байт. Это требуется для того что ,бы мызапись в файл производим по байтно}

End;

//перевод массива из четырех байт в число типа Integer.

Procedure ByteToInteger(mass: Integer_; var i: Integer);

var

a: ^Integer;

b: Integer_;

Begin

a:=@b;// соединяем адресс переменной b с а

b:=mass;//b присваиваем значение mass

i:=a^;{разименовываем а и соединяем результат с i

в результате работы этого кода массив из 4 байтперейд в число типа Integer. Это требуется для того что бы мымогли узнать наши значения типа Integer}

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);

{зисываем байты со статистикой (на каждую запись требуется по пять байт. Первый байт содержит сам символ далее идут 4 байта со статистикой (Intege занимает 4 байта)}

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_ это объект включающий в себя массив из байт ArrOfByteсчётчик байт ByteCount (необходим для учёта промежуточнойзапися разархивируемых байт в файл)и основной счётчик (необходимдля отслеживани какое количество байт должно быть разархивированокак только он стнет равным размеру сжимаемого файла то процессразархивирования первётся)}

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 //до тех пор пока GeneralCount меньше

//размера сжимаемого файла деаем

if GeneralCount<MainFile.Size

Then

Begin

inc(ByteCount); //увеличиваем соответствующие

//счётчики на единицу

inc(GeneralCount);

ArrOfByte[ByteCount]:=a;//загоняем в массив ArrOfByte

//значение полученное в переменной а

//////////////////////////

if ByteCount=MaxCount //если ByteCount=MaxCount

//то записываем содержимое массива в разархивируемый файл

Then

Begin

BlockWrite(FileToWrite,ArrOfByte,ByteCount);

ByteCount:=0;

//Form1.ProgressBar1.Position:=form1.ProgressBar1.Position+1;

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_;

CurrentPoint: TByte;

Begin

//определяем сколько целых буферов по 4 кбайт в сжатом

//файле без заголовка

CountBuf:=MainFile.FileSizeWOHead div count;

//определяем сколько останеся байт не вошедших

//в целые буферы по 4 кбайт в сжатом файле без заголовка

LastBuf:=MainFile.FileSizeWOHead mod count;

MainBuffer.CreateBuf;//иициализируем переменные

CurrentPoint:=MainFile.Tree;//присваиаем текущую

//позицию на корень дерева

//начинаем расаковку

For i:=1 to CountBuf do

Begin//считываем из сжатого файла данные в буфер

BlockRead(FileToRead,buf,count);

for j:=1 to Count do //по байтно начинаем

//просматривать буфер

Begin

for k:=1 to 8 do//просматриваем биты от 1 до 8

//выеленного байта

Begin {Выделяем байт в массиве. По циклу от 1 до 8просматриваем значения его бит с 7 до 0. Для этого используетсяоперация битового сдвига влево shl и логиеская операция and.

В цикле всё происходит следующим образом: Сначала просматриваетсястарший бит (8-к)=1 и производится логическая операция and,если бит равен 1 то (1 and 1)=1 и программа установит текущую позицию поиска в дереве на правый узел, если же бит равен 0 то (0 and 1)=0 и программа установит текущую позицию поиска в дереве на левый узел. так будет продолжатся до тех пор пока не выполнится условие, которое ознчает нахождение искомого символа ((CurrentPoint^.left=nil) or (CurrentPoint^.right=nil))

После этого будет вызвана процедура вставки байта, после возвращения из которой мы текущую точку опять устанавливаем на корень}

If (Buf[j] and (1 shl (8-k)))<>0

Then

CurrentPoint:=CurrentPoint^.right

Else

CurrentPoint:=CurrentPoint^.left;

if (CurrentPoint^.left=nil) or (CurrentPoint^.right=nil)

Then

Begin

MainBuffer.InsertByte(CurrentPoint^.Symbol);

CurrentPoint:=MainFile.Tree;

End;

Application.ProcessMessages;

End;

Application.ProcessMessages;

End;

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

CurrentPoint:=CurrentPoint^.right

Else

CurrentPoint:=CurrentPoint^.left;

if (CurrentPoint^.left=nil) or (CurrentPoint^.right=nil)

Then

Begin

MainBuffer.InsertByte(CurrentPoint^.Symbol);

CurrentPoint:=MainFile.Tree;

End;

Application.ProcessMessages;

End;

Application.ProcessMessages;

End;

End;

MainBuffer.FlushBuf;

End;

//процедура чтения заголовка архива

Procedure ReadHead;

var

b: Integer_; // исходный размер файла

SymbolSt: Integer;//статистика символа

count_, SymbolId, i: Byte;//SymbolId=Symbol просто чтобы

// не путать глобальную переменную с локальной

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);

ДОБАВИТЬ КОММЕНТАРИЙ  [можно без регистрации]
перед публикацией все комментарии рассматриваются модератором сайта - спам опубликован не будет

Ваше имя:

Комментарий

Хотите опубликовать свою статью или создать цикл из статей и лекций?
Это очень просто – нужна только регистрация на сайте.