//и устанавливаем указатель на неё
massiv[i]^.Symbol:=i;
massiv[i]^.SymbolStat:=0;
massiv[i]^.left:=nil;
massiv[i]^.right:=nil;
Application.ProcessMessages;//Высвобождаем ресурсы
//чтобы приложение не казалось зависшим, иначе все ресуры процессора
//будут задействованы на обработку кода приложения
End;
End;
{процедура для вычисления частот появления
i-го элемента в сжимаемом файле вызывается строка(310)}
Procedure TStat.Inc(i: Byte);
Begin //увеличиваем значение статистики символа [i] наединицу
massiv[i]^.SymbolStat:=massiv[i]^.SymbolStat+1;
End;
Type
//объект включающий в себя:
//имя и путь к архивируемому файлу
//размер архивируемого файла
//массив статистики частот байтов
//дерево частот байтов
//функцию генерации по имени файла имени архива
//функцию генерации по имени архива имени исходного файла
//функцию для определения размера файла без заголовка
//иными словами возвращающую смещение в архивном файле
//откуда начинаются сжатые данные
File_=Object
Name: String;
Size: Integer;
Stat: TStat;
Tree: TByte;
Function ArcName: String;
Function DeArcName: String;
Function FileSizeWOHead: Integer;
End;
// генерация по имени файла имени архива
Function File_.ArcName: String;
Var
i: Integer;
name_: String;
Const
PostFix=ArchExt;
Begin
name_:=name;
i:=Length(Name_);
While (i>0) And not(Name_[i] in ['/','\','.']) Do
Begin
Dec(i);
Application.ProcessMessages;
End;
If (i=0) or (Name_[i] in ['/','\'])
Then
ArcName:=Name_+'.'+PostFix
Else
If Name_[i]='.'
Then
Begin
Name_[i]:='.';
// Name_[i]:='!';
ArcName:=Name_+'.'+PostFix;
End;
End;
// генерация по имени архива имени исходного файла
Function File_.DeArcName: String;
Var
i: Integer;
Name_: String;
Begin
Name_:=Name;
if pos(dot+ArchExt,Name_)=0
Then
Begin
ShowMessage('Неправильное имя архива,'#13#10'оно должно заканчиваться на ".'+ArchExt+'"');
Application.Terminate;
End
Else
Begin
i:=Length(Name_);
While (i>0) And (Name_[i]<>'.') Do //до тех пор пока
//не встритится '.' !
Begin
Dec(i); //уменьшаем счётчик на единицу
Application.ProcessMessages;
End;
If i=0
Then
Begin
Name_:=copy(Name_,1,pos(dot+ArchExt,Name_)-1);
If Name_=''
Then
Begin
ShowMessage('Неправильное имя архива');
Application.Terminate;
End
Else
DeArcName:=Name_;
End
Else
Begin
Name_[i]:='.';
Delete(Name_,pos(dot+ArchExt,Name_),4);
DeArcName:=Name_;
End;
End;
End;
Function File_.FileSizeWOHead: Integer;
Begin
FileSizeWOHead:=FileSize(FileToRead)-4-1-
(Stat.CountByte+1)*5;
//размер исходного файла записывается в 4 байтах
//количество оригинальных байт записывается в 1байте
//количество байтов со статистикой - величина массива
End;
//процедура сортировки массива с байтами (сортировка производится
//по убыванию частоты байта (743)
procedure SortMassiv(var a: BytesWithStat; LengthOfMass: byte);
var
i,j: Byte; //счётчики циклов
b: TByte;
Begin //сортировка перестановкой
if LengthOfMass<>0
Then
for j:=0 to LengthOfMass-1 do
Begin
for i:=0 to LengthOfMass-1 do
Begin
If a[i]^.SymbolStat < a[i+1]^.SymbolStat
Then
Begin
b:=a[i]; a[i]:=a[i+1]; a[i+1]:=b;
End;
Application.ProcessMessages;
End;
Application.ProcessMessages;
End;
End;
//процедура удаления динамической структуры частотного дерева
//из памяти
Procedure DeleteTree(Root: TByte);
Begin
Application.ProcessMessages;
If Root<>nil
Then
Begin
DeleteTree(Root^.left);
DeleteTree(Root^.right);
Dispose(Root);
Root:=nil;
End;
End;
//создание дерева частот для архивируемого файла Haffman (777)
Procedure CreateTree(var Root: TByte; massiv: BytesWithStat;
last: byte);
var
Node: TByte;//узел
Begin
//sort_mass(massiv, last);
If last<>0 //если не 0 то начинаем строить дерево
Then
Begin
SortMassiv(massiv, last);//сортируем по убыванию
//частоты появления символа
new(Node);//создаёмо новый узел
//присваиваем ему вес двух самых лёгких эементов
//т.е. складываем статистику этих элементов
Node^.SymbolStat:=massiv[last-1]^.SymbolStat + massiv[last]^.SymbolStat;
Node^.left:=massiv[last-1];//от узла делаем ссылку на левую
Node^.right:=massiv[last];//и правую ветки
massiv[last-1]:=Node;// удаляем два последних элемента
//из массива на место предпоследнего из них ставим
//сформированный узел
///////////////// проверяем не достигли ли корня
if last=1//если =1 то да
Then
Begin
Root:=Node; //устанавливаем корневой узел
End
Else
Begin
CreateTree(Root,massiv,last-1);//если нет то строим
//древо дальше
End;
End
Else//если значение last в самом начале =0 т.е. файл
//содержит один и тот же символ (если файл состоит или
//из одного байта или из чередования одного итогоже символа)
Root:=massiv[last];//то вершина дерева будет от last
Application.ProcessMessages;
End;
var
//экземпляр объекта для текущего сжимаемого файла
MainFile: file_;
//процедура для полного анализа частот байтов встречающихся хотя бы
//один раз в исходном файле
procedure StatFile(fname: String);
var
f: file; //переменная типа file в неё будем писать
i,j: Integer;
buf: Array [1..count] of Byte;//массив=4кБ содержащий в
//себе часть архивируемого файла до 4кБ делается это для ускорения
//работы програмы
countbuf, lastbuf: Integer;//countbuf переменная которая показывает
//какое целое количество буферов=4кБ содержится в исходном файле
//для анализа частот символов встречающих в исходнлм файле
//lastbuf остаток байт которые неободимо будет проанализировать
Begin
AssignFile(f,fname);//связываем файловую переменню f
//с архивируемым файлом
Try //на всякий случай
Reset(f,1);//открываем файл для чтения
MainFile.Stat.create;//вызываем метод инициализации объекта
//для архивируемого файла (58)
MainFile.Size:=FileSize(f);//метод определения размера
// архивируемого файла. Стандартная функция FileSize
//возвращает начение в байтах
///////////////////////
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 //мы берём из буфера элемент от 1 до 4096 и с этими
//параметрами вызываем функцию Stat.inc(элемент)
//он же будет являтся и указателем на самого себя в
//в массиве символов там мы просто увеличиваем значение
//SymbolStat(частоты появления) на единицу
MainFile.Stat.inc(buf[j]);//(строка 80)
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]);//(80)
Application.ProcessMessages;
End;
Application.ProcessMessages;
End;
CloseFile(f);//Закрываем файл
Except //Если чтото не так то выводим сообщение
ShowMessage('ошибка доступа к файлу!')
End;
End;
{функция поиска в дереве Found(Tree: TByte; i: byte): Boolean;
параметры Tree:корень дерева или его узел, i:символ кодовое слово которого ищем; возвращает булево значение в функцию HSymbolToCodWord.
Алгоритм работы:
функция HSymbolToCodWord вызывает функцию Found(Tree^.left,i) т.е c параметром поиска в левой ветке дерева начиная от корня. Функция Found будет рекурсивно вызывать сама себя двигаясь по узлам дерева пока не дойдёт до искомого символа. Если там окажется искомый символ то Found вернёт true и в HSymbolToCodWord запишется первый нолик если Found(Tree^.left,i):true или единичка если Found(Tree^.right,i):true далее HSymbolToCodWord вызывает Found, но уже в параметрах указывается не корень, а седующий за ним узел, находящийся слева или справа, в зависимости от пред идущего результата поиска (в какой ветви от корня был найден символ(если слева его не было зачем там искать)) так будет продолжатся до тех пор пока HSymbolToCodWord не будет достигнут символ т.е. параметры функции будут Tree=узлу где находится символ (т.е. указатели на левую и правую ветви =nil)далее при выполнении функции она выработает значение для Tree=nil. Далее Found вернёт значение
Tree= узлу где нахоится искомый символ, выработает значение Found=True и вернётся в вызывающую функцию HSymbolToCodWord где в значение
HSymbolToCodWord в конец запишется '+'-означающий что кодовое слово найдено. Псле этого HSymbolToCodWord вернёт в вызвавшую её функциюSymbolToCodWord значение кодового слова+'+'на конце где произойдё проверка и символ '+' будет удалён, в вызывающий метод Stat.massiv[i]^.CodWord будет возвращено значение кодового слова}Function Found(Tree: TByte; i: byte): Boolean;
Begin
Application.ProcessMessages;
if (Tree=nil)//если древо nil то
Then
Found:=False //функция прекращает работу
Else //иначе
Begin //если указатель на левую часть древа или
//на правую nil, и указатель на символ равен счётчику
if ((Tree^.left=nil) or (Tree^.right=nil))
and (Tree^.Symbol=i)
Then
Found:=True {то функция возвращает флаг, что найден символ
и прекращает работу и возвращает в вызвавшую её функцию }
Else //иначе функция продолжает поиск от других узлов
//т.е.рекурсивно вызывает сама себя с другими параметрами
Found:=Found(Tree^.left, i) or Found(Tree^.right, i);
End;
End;
//функция для определения строкового представления сжатой последовательности
//битов для исходного байта i
Function HSymbolToCodWord(Tree: TByte; i: Byte): String;
Begin
Application.ProcessMessages;
if (Tree=nil)
Then
HSymbolToCodWord:='+=='
Else
Begin
if (Found(Tree^.left,i))//если символ находится в левой ветви
//в зависимости от того что вернула Found
Then //то в строку добавляем символ нуля и вызываем HSymbolToCodWord
//от ниже лежащего левого узла
HSymbolToCodWord:='0'+HSymbolToCodWord(Tree^.left,i)
Else
Begin
if Found(Tree^.right,i)//если символ находится в правой ветви
Then //то в строку добавляем символ единицы и вызываем HSymbolToCodWord
//от ниже лежащего правого узла
HSymbolToCodWord:='1'+HSymbolToCodWord(Tree^.right,i)
Else //иначе
Begin //если найден символ
If (Tree^.left=nil) and (Tree^.right=nil)
and (Tree^.Symbol=i)
Then //HSymbolToCodWord //помечаем символ найден
HSymbolToCodWord:='+'
Else //иначе
HSymbolToCodWord:=''; //символа нет
End;
End;
End;
End;
//вспомогательная функция для определения Кодового слова
//сжатой последовательности битов для исходного байта i (с учетом
//того экстремального случая, когда исходный файл состоит всего из одного
//и того же символа)
Function SymbolToCodWord(Tree: TByte; i: Byte): String;
var
s: String;
Begin //Вызыаем ф-ию поиска кодовых слов
s:=HSymbolToCodWord(Tree, i);
s:=s;
If (s='+'){если функция HSymbolToCodWord вернула строку
содержащую '+' т.е. исходный файл состоит из одного и того же