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;
Проверка на остаток производится аналогично предыдущей процедуре. Поиск кодовых слов в остатке производится путем проверки определенных элементов кодовых слов. Сравнение и запись идентичны.
ifconR [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 бит.
Лучше всего подвергаются сжатию текстовые документы, менее сжимаемы и плохо сжимаемы мультимедия файлы.