Содержание
Краткое описание работыпрограммы
Код программы
Результаты тестированияприложения
Краткое описание работы программы
Используемые компоненты средыDelphi:
1. SaveDialog, OpenDialog. Копомнентынеобходимые для чтения и сохранения файлов, а так же получения названия файла иего пути до него.
2. Button — компонент кнопка.
3. ListBox — компонент, состоящий из строк, хранит кодовыеслова.
4. ProgressBar — компонент, необходимый для отслеживанияэтапов выполнения программы.
5. Label — компонент для вывода строковых данных.
Краткое описание работы приложения:
1. При нажатии кнопки Button1 “Считать для сжатия” происходитполучение имени считываемого файла и пути до него. Измеряется размер файла (функцияFileSize). Полностью очищаются Label.
2. При нажатии кнопки Button2 “Проверить” происходитобнуление всех необходимых для работы переменных. Запускается процесс считывания(по-байтово) и анализа сжимаемого файла, в результате которого высчитывается средняядлинна кодового слова. Она необходима для определения возможности сжатия. В зависимостиот полученного результата выводится сообщение о том, что файл можно сжимать, в противномслучае, что нельзя. Так же формируется массив частот повторений символов в файле,необходимый для соотнесения кодовых слов и символов в файле.
3. При нажатии Button3 “Сжать” происходит побайтовоесчитывание сжимаемого файла с помощью команды BlockRead.Далее происходит соотнесение считанного байта кодовому слову. Алгоритм соотнесенияоснован на частоте появлений символов в файле. Чем чаще данный символ встречаетсяв файле, тем меньшей длинны ему присваивается кодовое слово. Запись нового файлапроизводится с помощью команды BlockWrite так же по-байтово. Новому файлу присваивается новое расширение.Когда файл полностью считан, выполняется проверка на наличие оставшихся битов. Еслитаковые имеются, то пустое пространство забивается нулями до тех пор, пока количествобитов не будет равно 8.
4. При нажатии Button4 “Считать для восстановления”происходит получение имени сжатого файла, пути до него.
5. При нажатии Button5 “Восстановить" происходитпобайтового считывание файла. Алгоритм разжатия состоит из двух этапов. На первомэтапе происходит считывание файла блоками размером в 1 байт. Производится записьсчитанных байтов в специальную переменную. Когда длина переменной составляет 16символов или более, начинается анализ считанной информации. Производится проверкана соответствие кодовым словам и последующая запись полученных значений в новыйфайл. На втором этапе производится проверка на остаток и удаление лишних данных(случай, когда было выполнено дополнение нулями при сжатии).
Кодпрограммы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes,Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class (TForm)
ListBox1: TListBox;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Label1: TLabel;
ProgressBar1: TProgressBar;
Button4: TButton;
Button5: TButton;
Label3: TLabel;
Label4: TLabel;
Label2: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
SaveDialog2: TSaveDialog;
OpenDialog2: TOpenDialog;
procedure Button1Click (Sender: TObject);
procedure FormCreate (Sender: TObject);
procedure Button2Click (Sender: TObject);
procedure Button3Click (Sender: TObject);
procedure Button4Click (Sender: TObject);
procedure Button5Click (Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
f,f1,f2,f3: file;
buff: byte;
conR,conW: string;
a: array [0.255] of real; // массив вероятностей
word: array [0.255] of string; // массивкодовых слов
l: array [0.255]of byte;// массив длин кодовых слов
e: array [0.255]of real;// массив номеров элементов
inf: array [0.255]of integer; // массив служебной информации
i,j,k,size,prog,buff1,buff3,check,dop: integer;
sl,sum,sort,sort1,buff2: real;
implementation
{$R *.dfm}
procedure TForm1.Button1Click (Sender: TObject);
begin
if OpenDialog1.Execute then
AssignFile (f,OpenDialog1.FileName); // считываемимя файла и путь до него
Reset (f,1);// открываем файл для чтения и изменения
size: =FileSize(f); // измеряем размер файла
Label4.Caption: =IntToStr (size) + ' байт';
// выводим размер файла в Label4
Label2.Caption:='';
Label6.Caption: ='';
Label8.Caption: ='';
end;
procedure TForm1.Button2Click (Sender: TObject);
begin
ProgressBar1.Position: =0; // обнуляемProgressBar
prog: =0; // обнуляем счетчик для Progress Bar
sl: =0; // обнуляем переменную среднейдлинны
sum: =0; // обнуляем счетчик повторенийсимволов
sort: =0; // обнуляем переменные длясортировки массива номеров элементов
sort1: =0;
buff: =0;
for i: =0 to 255 do
begin
e [i]: =i; // производим обнуление элементов массивов кодовых слов, длинкодовых слов, вероятностей и номеров элементов.
l [i]: =0;
word [i]: ='';
a [i]: =0;
end;
while not EOF (f) do // считываем файл до его окончания
begin
BlockRead (f,buff,1); // считываем блоки в 1 байт
a [buff]: =a [buff] +1; // записываем этот байт вмассив
prog: =prog+1;
ProgressBar1.Position: =round ( (prog/size)*100);
end;
for i: =0 to 255 do
begin
word [i]: =ListBox1. Items.Strings[i]; // записываем кодовые слова из ListBox1в массив кодовых слов
if a [i] 0 then// проверяем наличие байта в массиве
begin
sum: = sum+a [i]; // считаем количество повторенийданного байта
end;
end;
CloseFile (f);// закрываем файл после чтения
for i: =0 to 255 do
begin
for j: =0 to 254 do
begin
if (a [j]
begin
sort: =a [j]; // производим сортировку массива номеров элементов
sort1: =e [j];
a [j]: =a [j+1];
a [j+1]: =sort;
e [j]: =e [j+1];
e [j+1]: =sort1;
end;
end;
end;
for k: =0 to 255 do
begin
if a [k] 0 then// проверяем наличие элементов в массиве
begin
a [k]: =a [k] /sum;// считаем у появления символа
l [k]: =length (word [k]);// высчитываем длину кодовых слов
sl: =sl+l [k] *a [k]; // получаем значение средней длинны
end;
end;
Label2.Caption:=FloatToStr (sl); // выводим значениесредней длины
if sl
begin
Button3.Enabled: =true; // активируем кнопку“Сжать”
showmessage ('Сжатие возможно');
end;
if sl > 8 then
begin
showmessage ('Сжатие невозможно');
end;
end;
procedure TForm1.Button3Click (Sender: TObject);
begin
SaveDialog1.FileName: =OpenDialog1.FileName+'.gop';
// задаем новое расширение для сжатого файла
SaveDialog1.DefaultExt: ='gop';
if SaveDialog1.Execute then
begin
AssignFile (f1, SaveDialog1.FileName);
Rewrite (f1,1);// открываем файл для записи
end;
buff1: =0;
i: =0;
while i 256 do// записываем служебную информацию в новый файл.
begin
buff1: =StrToInt (FloatToStr (e [i]));
BlockWrite (f1,buff1,1);
Reset (f,1);
i: =i+1;
end;
buff1: =0;
seek (f1,256);// осуществляем переход на 256-ой байт в файле
ProgressBar1.Position: =0;
prog: =0;
while not EOF (f) do // считываем файлдо его окончания
begin
BlockRead (f,buff,1); // считываем блоки размером 1 байт
buff1: =buff1+1;
prog: =prog+1;
for i: =0 to 255 do
begin
if buff=e [i] then // проверяем совпадения
begin
conR: =conR+word [i]; // записываем соответствующеекодовое слово
if length (conR) >=8 then // проверяем длину переменной
begin
conW: =copy(conR,1,8); // копируем первые 8 символов
buff2: = ( (strtoint (conW [1])) *128) + ((strtoint (conW [2])) *64) + ( (strtoint (conW [3])) *32) + ( (strtoint (conW [4]))*16) + ( (strtoint (conW [5])) *8) + ( (strtoint (conW [6])) *4) + ( (strtoint(conW [7])) *2) + (strtoint (conW [8]));
// переводим скопрированную информацию в десятичное число
buff3: =strtoint(floattostr (buff2));
BlockWrite (f1,buff3,1); // записываем результат в новый файл
Delete (conR,1,8);// удаляем первые 8 символов
end;
if (EOF (f) =true) and (conR'') and(length (conR)
// проверяем наличие остатка
begin
k: =0;
check: =length(conR); // вычисляем длину остатка
dop: =8-check;// вычисляем количество необходимых для заполнения битов
while kdop do // цикл дополнения нулями
begin
conR: =conR+'0';// дописываем нули
k: =k+1;
end;
conW: =copy (conR,1,8); // копируем данные
buff2: = ( (strtoint (conW [1])) *128) + ((strtoint (conW [2])) *64) + ( (strtoint (conW [3])) *32) + ( (strtoint (conW [4]))*16) + ( (strtoint (conW [5])) *8) + ( (strtoint (conW [6])) *4) + ( (strtoint(conW [7])) *2) + (strtoint (conW [8]));
// переводим скопированную информацию в десятичное число
buff3: =strtoint(floattostr (buff2));
BlockWrite (f1,buff3,1); // записываем полученные значения
end;
end;
end;
ProgressBar1.Position: =Round ( (prog/size)*100);
end;
Label6.Caption: =Inttostr (FileSize (f1)) +' байт';
// выводим размер полученного файла
Label8.Caption: =IntToStr (Round (100- (FileSize(f1) *100/size))) + ' %';
// считаем процент сжатия файла
ShowMessage ('Файл успешно сжат');
CloseFile (f); // закрываем файлы
CloseFile (f1);
conR: =''; // обнуляем переменные
conW: ='';
Button3.Enabled: =false;
end;
procedure TForm1.Button4Click (Sender: TObject);
begin
if OpenDialog2.Execute then
AssignFile (f2,OpenDialog2.FileName); // считываемимя файла и путь до него
Reset (f2,1);// открываем файл для чтения и записи
size: =FileSize(f2); // запоминаем размер файла
Label4.Caption: =IntToStr (size) + ' байт';
Label2.Caption: ='';
Label6.Caption: ='';
Label8.Caption: ='';
Button5.Enabled: =true;
for i: =0 to 255 do
begin
BlockRead (f2,buff,1);
inf [i]: =buff; // задаем соответствие по служебной информации
word [i]: =ListBox1. Items.Strings [i]; // считываеммассив кодовых слов
end;
end;
function IntToBin (n: Integer):String; // перевод из десятичного значения в двоичное
var
m: integer;
begin
Result: ='';
while n0 do
begin
if n and 1=0 then Result: ='0'+Result else Result:='1'+Result;
n: =n shr 1;
end;
if length (result)
begin
for m: =1 to 8-length (result) do result: ='0'+result;
end;
end;
procedure TForm1.Button5Click (Sender: TObject);
begin
if SaveDialog2.Execute then
begin
ProgressBar1.Position: =0;
prog: =0;
AssignFile (f3, SaveDialog2.FileName); // считываемимя файла и путь до него
ReWrite (f3,1);// открываем файл для записи
conR: =''; // обнуляем рабочие переменные
conW: ='';
seek (f2,256);// переходим на 256-ой байт
form1.Refresh;
While not EOF (f2) do // считываем файл до его окончания
begin
if length (conR)
begin
BlockRead (f2,buff,1); // считываем файл по 1 байту
conR: =conR+IntToBin (buff); // переводим считанныйбайт в двоичное число
prog: =prog+1;
end;
if length (conR) >=16 then // проверяемдлину переменной
Дальнейший код основан на проверке определенных элементов кодовыхслов. Так как кодовые слова имеющие смещение отличаются от предыдущих кодовых словбез смещения появлением в начале кодового слова дополнительных нулей, то необходимопроверять всего два элемента в кодовом слове. Поэтому массив разбивается на промежутки,что ускоряет поиск подходящих кодовых слов. Для первых 6 элементов массива кодовыхслов достаточно одного условия проверки.
begin
if conR [1] ='1' then
begin
conW: =copy(conR,1,2); // копируем кодовое слово
for i: =0 to 1 do
begin
if word [i] =conW then // сравниваем массив кодовых словв заданном промежутке с выделенным кодовым словом
begin
BlockWrite (f3,inf [i],1); // записываем полученныйэлемент в файл
Delete (conR,1,2);// удаляем кодовое слово
break; // прерываем цикл
end;
end;
end
else
if conR [2] ='1' then
begin
conW: =copy (conR,1,4);
for i: =2 to 5 do
begin
if word [i] =conW then
begin
BlockWrite (f3, inf [i],1);
Delete (conR,1,4);
Break;
end;
end;
end
else
if (conR [2] ='0') and (conR [3] ='1') then
begin
conW: =copy (conR,1,6);
for i: =6 to 13 do
begin
if word [i] =conW then
begin
BlockWrite (f3, inf [i],1);
Delete (conR,1,6);
Break;
end;
end;
end
else
if (conR [3] ='0') and (conR [4] ='1') then
begin
conW: =copy (conR,1,8);
for i: =14 to 29 do
begin
if word [i] =conW then
begin
BlockWrite (f3, inf [i],1);
Delete (conR,1,8);
Break;
end;
end;
end
else
if (conR [4] ='0') and (conR [5] ='1') then
begin
conW: =copy (conR,1,10);
for i: =30 to 61 do
begin
if word [i] =conW then
begin
BlockWrite (f3, inf [i],1);
Delete (conR,1,10);
Break;
end;
end;
end
else
if (conR [5] ='0') and (conR [6] ='1') then
begin
conW: =copy (conR,1,12);
for i: =62 to 125 do
begin
if word [i] =conW then
begin
BlockWrite (f3, inf [i],1);
Delete (conR,1,12);
Break;
end;
end;
end
else
if (conR [6] ='0') and (conR [7] ='1') then
begin
conW: =copy (conR,1,14);
for i: =126 to 253 do
begin
if word [i] =conW then
begin
BlockWrite (f3, inf [i],1);
Delete (conR,1,14);
Break;
end;
end;
end
else
if (conR [7] ='0') and (conR [8] ='1') then
begin
conW: =copy (conR,1,16);
for i: =254 to 255 do
begin
if word [i] =conW then
begin
BlockWrite (f3, inf [i],1);
Delete (conR,1,16);
Break;
end;
end;
end;
if (EOF (f2) = true) and (length (conR) >1)then
// проверяем остаток
begin
for j: =1 to length (conR) do // считаемдлину остатка
begin
if conR='' then break;
Проверка на остаток производится аналогично предыдущей процедуре.Поиск кодовых слов в остатке производится путем проверки определенных элементовкодовых слов. Сравнение и запись идентичны.
if conR [1] ='1' then
begin
conW: =copy(conR,1,2);
for i: =0 to 1 do
begin
if word [i] =conW then
begin
BlockWrite (f3, inf [i],1);
delete (conR,1,2);
break;
end;
end;
end
else
if (conR [1] ='0') and (conR [2] ='1') then
begin
conW: =copy (conR,1,4);
for i: =2 to 5 do
begin
if word [i] =conW then
begin
blockWrite (f3, inf [i],1);
delete (conR,1,4);
break;
end;
end;
end
else
if (conR [2] ='0') and (conR [3] ='1') then
begin
conW: =copy (conR,1,6);
for i: =6 to 13 do
begin
if word [i] =conW then
begin
BlockWrite (f3, inf [i],1);
Delete (conR,1,6);
break;
end;
end;
end
else
if (conR [3] ='0') and (conR [4] ='1') then
begin
conW: =copy (conR,1,8);
for i: =14 to 29 do
begin
if word [i] =conW then
begin
BlockWrite (f3, inf [i],1);
Delete (conR,1,8);
break;
end;
end;
end
else
if (conR [4] ='0') and (conR [5] ='1') then
begin
conW: =copy (conR,1,10);
for i: =30 to 61 do
begin
if word [i] =conW then
begin
BlockWrite (f3, inf [i],1);
Delete (conR,1,10);
break;
end;
end;
end
else
if (conR [5] ='0') and (conR [6] ='1') then
begin
conW: =copy (conR,1,12);
for i: =62 to 125 do
begin
if word [i] =conW then
begin
BlockWrite (f3, inf [i],1);
Delete (conR,1,12);
break;
end;
end;
end
else
if (conR [6] ='0') and (conR [7] ='1') then
begin
conW: =copy (conR,1,14);
for i: =126 to 253 do
begin
if word [i] =conW then
begin
BlockWrite (f3, inf [i],1);
Delete (conR,1,14);
break;
end;
end;
end
else
if (conR [7] ='0') and (conR [8] ='1') then
begin
conW: =copy (conR,1,16);
for i: =254 to 255 do
begin
if word [i] =conW then
begin
BlockWrite (f3, inf [i],1);
Delete (conR,1,16);
break;
end;
end;
end;
end;
end;
end;
ProgressBar1.Position: =Round ( (prog/size)*100);
end;
Label6.Caption: =IntToStr (FileSize (f3)) +' байт';
ShowMessage ('Процедура завершена');
end;
CloseFile (f3);
CloseFile (f2);
end;
procedure TForm1.FormCreate (Sender: TObject);
begin
for i: =0 to 255 do
a [i]: =0;
e [i]: =i;
end;
end.
/>
Рис.1. Интерфейс программы
Результаты тестирования приложения:
Работа приложения тестировалась на различных типах файлов. Использовалисьфайлы графического, текстового, мультимедийного и других форматов. Все данные опроцессах сжатия изложены в следующей таблице.Имя\тип файла Размер до сжатия Имя сжатого файла Размер после сжатия Сжатие 8bit org.bmp 68,7 КБ 8bit org.bmp.gop 18,1 КБ 73% 24bit org.bmp 203 КБ 24bitorg.bmp.gop 54,1 КБ 73% DOC org.doc 1516 КБ DOC org.doc.gop 843 КБ 45% RTF org.rtf 711 КБ RTF org.rtf.gop 539 КБ 24% TXT org.txt 1 619 байт TXT org.txt.gop 1 392 байт 14% midi org.mid 40 075 байт midi org.mid.gop 36 551 байт 9% Unit1 org.pas 15 721 байт Unit1 org.pas.gop 9 068 байт 42%
Максимальный размер сжатия составляет 73-75%. В данной таблицеотображены форматы файлов, которые можно было сжать. Однако некоторые форматы всвязи со своей спецификой несут в себе определенные методы сжатия данных, что непозволяет приложению производить операции над ними. К таким форматам относятся:*.tiff, *.gif, *.wav, *.jpeg, *.avi,*.mp3, *.3gp, *.odt.
Процент сжатия характеризуется длиной кодовых слов и смещением.В данном случае максимальный процент сжатия будет 75%, так как минимальная длинакодового слова равна 2. Сжатие файла происходит побайтово, следовательно заменяемкодовым словом из 2 бит блоки из 8 бит.
Лучше всего подвергаются сжатию текстовые документы, менее сжимаемыи плохо сжимаемы мультимедия файлы.