(495) 925-0049, ITShop интернет-магазин 229-0436, Учебный Центр 925-0049
  Главная страница Карта сайта Контакты
Поиск
Вход
Регистрация
Рассылки сайта
 
 
 
 
 

Модуль архивации - создание и использование

Источник: programmersclub
Ahilles

Сегодня я расскажу вам, как пользоваться библиотекой ZLib которая начала поставляться с Delphi начиная с версии 7. Конечно, её можно было использовать и в предыдущих версиях, но для правильного функционирования программы нужно было всё время таскать вместе с программой библиотеку ZLib.dll. В седьмой версии всё стало проще, Delphi внедряла прямо в программу этот модуль с максимальной оптимизацией. Поэтому нам можно не думать о том, как программе носить с собой библиотеку ZLib.dll.

    Итак, приступим к делу.

Для того чтобы воспользоваться библиотекой ZLib нам надо подключить модуль ZLib к нашей программе.
Этот модуль предоставляет нам два класса-потока:
TCompressionStream
и
TDecompressionStream

    Вот как будет выглядеть сжатие файла:

var

  source,dest:TFileStream;//поток-источноик, поток-приёмник

  CompresSstream:TCompressionStream;    // поток - архиватор

  bytesread:integer;  

  mainbuffer:array[0..1023] of char; // буфер

begin

  source:=TFileStream.Create('< Путь к файлу >',fmOpenRead);   // создаём поток - источник

  dest:=TFileStream.Create('< Путь к результату >',fmCreate); // создаём поток - приёмник

  CompresSstream:=TCompressionStream.Create(clMax,dest);// создаём поток - архиватор c                   //          максимальной степенью сжатия

  try                // НА ВСЯКИЙ ПОЖАРНЫЙ

   repeat                     

    bytesread:=source.Read(mainbuffer,buffer_size);    // считываем из источника в буфер

    CompresSstream.Write(mainbuffer,bytesread);     //   записываем из буфера в поток - архиватор

    until bytesread<1024;   // всё это до тех пор пока весь источник не будет считан

  except    //   если всё же возникнет какая-нибудь оБшибка!!!

   CompresSstream.free;

   source.Free;

   dest.Free;

   exit;

  end;   // всё прошло успешно

  CompresSstream.free;

  source.Free;

  dest.Free;

end;

    Примерно так-же будет выглядеть распаковка файла

var

  source,dest:TFileStream;

  decompressStream:TDecompressionStream; //

  bytesread:integer;

  mainbuffer:array[0..1023] of char;

begin

  source:=TFileStream.Create('< Путь к файлу >',fmOpenRead);

  dest:=TFileStream.Create('< Путь к результату >',fmCreate);

  decompressStream:=TDecompressionStream.Create(source); //

  try

  repeat

   bytesread:=decompressStream.Read(mainbuffer,buffer_size);

   dest.Write(mainbuffer,bytesread);

  until bytesread<1024;

  except

  decompressStream.Free;

  source.Free;

  dest.Free;

  exit;

  end;

  decompressStream.Free;

  source.Free;

  dest.Free;

end;

    НО не для этого я написал эту статью! Многие хотят, чтобы процесс архивации отображался на форме в каком-нибудь компоненте и чтобы форма не зависала во время архивации. Именно для этих целей я напишу модуль прямо на ваших глазах. В этом модуле тоже будет только две функции.

Назавём этот модуль так: ZLibAdvTools.

                                          ZLib

                                         Advanced усовершенствованные

                                         Tools инструменты

               ZLibAdvTools.

               ^^     ^      ^

               ZL   A      T

Сначала про функцию сжатия. Назовём эту фунцкию ZLATCompressFile.

function ZLATCompressFile(

                          sourcefile:string;          //<----/---- это понятно

                          destinationfile:string;    //<----/

                          compressRatio:integer;// степень сжатия

                          refreshWnd:boolean;// надо ли обновлять окно во время архивации

                          needcreate:boolean;// надо ли создавать файл-результат

                          progress:Pointer;//указатель на компонент прогресса, почему указатель, а не сам

                                                                                                                      //компонент   объясню позже         

                           min_value:integer; //<----/------- это тоже очень сильно пригодится

                          max_value:integer; //<---/

                          PositionPropName:string='Progress'     // имя свойства прогресса

                          ):integer;// результат

 

    Почему выбрал указатель на компонент прогресса, а не сам компонент. Для увеличения скорости работы функции. Ну, сами подумайте, если вы передадите своему другу на мыло 100 метровый файл или просто отправите на мыло его URL. Здесь та же система: зачем передавать объект, если можно просто указать, где он находится памяти. Теперь зачем нам надо min_value и max_value. Допустим надо отобразить процесс копирования и архивации на компоненте в 100 "делений", тогда копирование будет от 0 до 50, а архивация от 50 до 100, правильно? вот для чего нам нужны эти значения. Параметру PositionPropName уже присвоено значение по умолчанию, поэтому при вызове функции этот параметр нужно ставить, если только свойство, обозначающее положение прогресса имеет другое имя.

    Теперь сама процедура:

function ZLATcompressfile;

var

  source,dest:TFileStream;                           

  CompresSstream:TCompressionStream;    

  bytesread:integer;

  bytes_read_d:int64;                       // поясню потом

  mainbuffer:array[0..buffer_size-1] of char;    // константа нужна для универсальности

                                                                  //её можно (т.е. нужно) объявить где-нибудь в начале

  zena_byta:real;    //<-----------------/

  interval:integer;    //<----------------/--------------терпение, только терпение!!!! всё объясню

  needProgress:boolean; //<---------/

begin

  needProgress:=false;// обнуляю

  source:=TFileStream.Create(sourcefile,fmOpenRead); //

  if needcreate then

  dest:=TFileStream.Create(destinationfile,fmCreate) // создаём объект вместе с созданием файла

               else

  dest:=TFileStream.Create(destinationfile,fmOpenWrite); // открываем в режиме чтения / записи

  if compressRatio=0 then

  CompresSstream:=TCompressionStream.Create(clDefault,dest);// степень сжатия по умолчанию

  if compressRatio=1 then

  CompresSstream:=TCompressionStream.Create(clFastest,dest);// самая быстрая степень сжатия

  if compressRatio=2 then

  CompresSstream:=TCompressionStream.Create(clMax,dest);// самая высокая степнь сжатия

  if compressRatio>2 then

  CompresSstream:=TCompressionStream.Create(clDefault,dest);

  interval:=max_value-min_value; // узнаём интервал в " делениях "

  if source.Size<>0 then

  zena _ byta := interval / source . Size //   zena _ byta = сколько байтов надо считать чтобы прибавилось  

                                                                                                                                      //одно "деление"

                   Else

  zena_byta:=interval;     // воизбежание оБшибок             

  Bytes_read_d:=0;           // она будет хранить общее количество байт, которое мы считали:

                                                                                                                                 // обнуляем её

  if progress<>nil then needProgress:=true; //если указатель прогресс есть, то будем отображать

                                                                                                                                 //        архивацию .

  if needprogress then

  begin

     {

 

    Теперь настало время рассказать о супер-фишке которой нет и никогда не будет в С++ чисто по своему определению!!!!

    procedure SetPropValue(Instance: TObject; const PropName: string; const Value: Variant);

    Присваивает свойству PropName заданное как СТРОКА!!! у объекта Instance значение Value которое может, быть ЛЮБОГО типа (integer, real, string, array и т.д. и т.п.)
     Эта процедура использует RTTI информацию объектов и очень сильно загромождает программу и советую её использовать, только если по другому нельзя!!
     Кстати, тип Variant - это тоже ВЕЛИКОЕ достижение компании Borland.
    И несколько слов про C++ Builder. По определению: откомпилированный экзешник языка С очень сильно отличается от Pascal'евского, поэтому С остаётся С даже если он от Borland}

SetPropValue(TObject(progress^),'Progress',min_value); // устанавливаем прогресс в начало

  end;

  try

   repeat   // пошёл тот самый   процесс

    bytesread:=source.Read(mainbuffer,buffer_size);

    CompresSstream.Write(mainbuffer,bytesread);

    Bytes_read_d:=bytes_read_d+bytesread; // обновляем переменную

    if refreshWnd then                   // если надо обновлять окно, то обновляем

     Application.ProcessMessages;

    if needprogress then                 // обновляем прогресс

     begin        

       SetPropValue(

                             TObject (progress^), // получаем из указателя переменную и преобразуем её к                           PositionPropName ', // любому классу (какой тип не важно).

                              min_value+round(Bytes_read_d*zena_byta) //получаем текущее положение

                             );

     end;

   until bytesread=0;

  except                        // блин !!! провал

   Result:=0;

   CompresSstream.free;

   source.Free;

   dest.Free;

   exit;

  end;

  CompresSstream.free;

  if source.Size<>0 then

  result:=round((100*dest.Size)/source.size) // результатом будет процент который составляет

                                                                        //                                            сжатый файл от исходного

                   else

  result:=dest.Size; // опять провал (интересно, тогда что мы сжимали, если размер источника равен нулю)

  source . Free ;

  dest.Free;

end;

Таким образом Функция возвращает процент, а если оБшибка, то 0.

С декомпрессией будет сложнее.

   function ZLATDecompressfile(

                                                 sourcefile:string;

                                                 destinationfile:string;

                                                 refreshWnd:boolean;

                                                 needcreate:boolean;

                                                 progress:Pointer;

                                                 min_value:integer;

                                                  max_value:integer ;

                                                   PositionPropName:string='Progress'

                                                 ):boolean;

    Здесь почти тоже самое только уже не нужна степень сжатия. Но есть другая проблема. Мы незнаем, сколько будет весить исходный файл, поэтому изначальное значение переменной zena_byta будет заведомо меньше. Например, мы распаковываем файл в 30 МВ, а изначально он весил 60 МВ, поэтому положение прогресса перейдёт за границу max_value. Как же решить эту проблему? Мы после каждой записи из буфера в переменную буде проверять, не превысил ли размер файла-приёмника размера сжатого файла, если да, то мы перерасчитаем переменную zena_byta. Конечно после таких действий при распаковке больших файлов и при слишком большом размере буфера прогресс будет скакать, то взад, то вперёд. Поэтому константе buffer_size лучше присвоить значение 1024 (это самое оптимальное значение - проверено опытом!!!).

function ZLATdecompressfile;

var

  source,dest:TFileStream;

  decompressStream:TDecompressionStream;

  bytesread:integer;

  bytesread_d:int64;

  interval:integer;

  zena_byta:real;                                           

  mainbuffer:array[0..buffer_size-1] of char;

  needProgress:boolean;                            

begin

  needprogress:=false;

  source:=TFileStream.Create(sourcefile,fmOpenRead);

  if needcreate then

  dest:=TFileStream.Create(destinationfile,fmCreate)

               else

  dest:=TFileStream.Create(destinationfile,fmOpenWrite);

  decompressStream:=TDecompressionStream.Create(source);

  result:=true;   // результат - это успешность проделанной нами операции

  interval:=max_value-min_value;

  zena_byta:=interval/source.Size;

  bytesread_d:=0;

  if progress<>nil then needProgress:=true;

  if needprogress then

  begin

    SetPropValue(TObject (progress^), PositionPropName,min_value);

  end;

  try

  repeat

   bytesread:=decompressStream.Read(mainbuffer,buffer_size);

   dest.Write(mainbuffer,bytesread);

   bytesread_d:=bytesread_d+bytesread;

   if refreshWnd then

     Application.ProcessMessages;

   if needprogress then

    begin                

     if bytesread_d>source.Size then   // самое интересное !!!

      begin                        // смотрим: если всего считано байт больше чем размер сжатого

       zena_byta:=interval/bytesread_d; // то перерасчитываем переменную zena_byta

      end;

     SetPropValue(TObject(progress^), PositionPropName,min_value+round(bytesread_d*zena_byta));

    end;

  until bytesread<buffer_size;

  except                                         //провал

  result:=false; // результат = НЕТ

  decompressStream.Free;

  source.Free;

  dest.Free;

  exit;

  end;

  decompressStream.Free;

  source.Free;

  dest.Free;

end;

 

    Итак, теперь нам надо скопировать файл ZLibAdvTools.pas в папку Lib в корневой папке Delphi и подключить этот модуль в любом месте программы: Uses ZLibAdvTools;

Ссылки по теме

Файлы для загрузки


 Распечатать »
 Правила публикации »
  Написать редактору 
 Рекомендовать » Дата публикации: 10.08.2009 
 

Магазин программного обеспечения   WWW.ITSHOP.RU
Delphi Professional Named User
Enterprise Connectors (1 Year term)
ABBYY Lingvo x6 Многоязычная Профессиональная версия, электронный ключ
VMware Horizon Apps Standard, v7 : 10 Pack (Named User)
SAP® Crystal Presentation Design 2016 WIN INTL NUL
 
Другие предложения...
 
Курсы обучения   WWW.ITSHOP.RU
 
Другие предложения...
 
Магазин сертификационных экзаменов   WWW.ITSHOP.RU
 
Другие предложения...
 
3D Принтеры | 3D Печать   WWW.ITSHOP.RU
 
Другие предложения...
 
Новости по теме
 
Рассылки Subscribe.ru
Информационные технологии: CASE, RAD, ERP, OLAP
Новости ITShop.ru - ПО, книги, документация, курсы обучения
Программирование на Microsoft Access
CASE-технологии
OS Linux для начинающих. Новости + статьи + обзоры + ссылки
СУБД Oracle "с нуля"
Новости мира 3D-ускорителей
 
Статьи по теме
 
Новинки каталога Download
 
Исходники
 
Документация
 
 



    
rambler's top100 Rambler's Top100