Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 953

Раздел: Delphi » Прочее
/ вопрос открыт /

Здравствуйте, эксперты!
Вопрос про архиватор. Мне требуется архивировать файлы различного размера. Это одна из многих функций - далеко не основная. Я использую готовое решение by Andrea Russo - Italy - 2005, выдранное из инета (исходники прикладываю). Проблема в том, что на разархивирование времени уходит болше чем на архивирование. Более того, с ростом размера файла к примеру от 100 мег до 600 мег время разархивирования увеличивается нелинейно (не в 6 а примерно в 15-20 раз) и в конечном итоге составляет до 1,5-2 часа.
Есть ли другие готовые решения (с исходниками) или как изменить это, чтобы поднять скорость архивирования - разархивирования скажем до 50-100 Мбайт в минуту с разными коэффициентами сжатя.

Приложение:
  1. <code>
  2. unit UtilityPasZlib;
  3.  
  4. // by Andrea Russo - Italy - 2005
  5. // email: andrusso@libero.it
  6.  
  7. interface
  8.  
  9. //Unit zlib is icluded into the latest version of Delphi (from Delphi 6), but in old versions is
  10. //included into the Delphi cd.
  11. // Otherwise if do you want to use paszlib library change the uses.
  12.  
  13. //If do you want to use zlib included into Delphi
  14.  
  15. uses zlib, Classes;
  16.  
  17. //If do you want to use paszlib library
  18. //uses dzlib, Classes;
  19.  
  20. type TCompLevel = (clNone, clFastest, clDefault, clMax);
  21.  
  22. procedure CompressFile(const sFileIn : string; const sFileOut : string; const Level : TCompLevel = clDefault);
  23. procedure UnCompressFile(const sFileIn : string; const sFileOut : string);
  24.  
  25. procedure CompressStream(inStream, outStream :TStream; const Level : TCompLevel = clDefault);
  26. procedure ExpandStream(inStream, outStream :TStream);
  27.  
  28. implementation
  29.  
  30. procedure CompressFile(const sFileIn : string; const sFileOut : string; const Level : TCompLevel = clDefault);
  31. var
  32. inStream, outStream: TMemoryStream;
  33. begin
  34. inStream:=TMemoryStream.Create;
  35. outStream:=TMemoryStream.Create;
  36. try
  37. inStream.LoadFromFile(sFileIn);
  38. with TCompressionStream.Create(TCompressionLevel(Level), outStream) do
  39. try
  40. CopyFrom(inStream, inStream.Size);
  41. finally
  42. Free;
  43. end;
  44. outStream.SaveToFile(sFileOut);
  45. finally
  46. outStream.Free;
  47. inStream.Free;
  48. end;
  49. end;
  50.  
  51. procedure UnCompressFile(const sFileIn : string; const sFileOut : string);
  52. var
  53. inStream, outStream: TMemoryStream;
  54. begin
  55. inStream:=TMemoryStream.Create;
  56. outStream:=TMemoryStream.Create;
  57. try
  58. inStream.LoadFromFile(sFileIn);
  59. ExpandStream(inStream, outStream);
  60. outStream.SaveToFile(sFileOut);
  61. finally
  62. inStream.Free;
  63. outStream.Free;
  64. end;
  65. end;
  66.  
  67. procedure CompressStream(inStream, outStream :TStream; const Level : TCompLevel = clDefault);
  68. begin
  69. with TCompressionStream.Create(TCompressionLevel(Level), outStream) do
  70. try
  71. CopyFrom(inStream, inStream.Size);
  72. finally
  73. Free;
  74. end;
  75. end;
  76.  
  77. procedure ExpandStream(inStream, outStream :TStream);
  78. const
  79. BufferSize = 4096;
  80. var
  81. Count: integer;
  82. ZStream: TDecompressionStream;
  83. Buffer: array[0..BufferSize-1] of Byte;
  84. begin
  85. ZStream:=TDecompressionStream.Create(InStream);
  86. try
  87. while true do
  88. begin
  89. Count:=ZStream.Read(Buffer, BufferSize);
  90. if Count<>0
  91. then OutStream.WriteBuffer(Buffer, Count)
  92. else Break;
  93. end;
  94. finally
  95. ZStream.Free;
  96. end;
  97. end;
  98.  
  99. end.
  100. </code>


Popovich E.V. Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Popovich E.V. (статус: Посетитель)
Вопрос отправлен: 3 октября 2007, 15:58
Состояние вопроса: открыт, ответов: 4.

Ответ #1. Отвечает эксперт: Вадим К

Здравствуйте, Popovich E.V.!
Причиной стремительного замедления может быть неудачная работа с памятью
для примера, потестируйте код

s:string;
begin
s:='';
for i:=1 to 1000 do s:=s+'*';
и код
s:string;
begin
s:='';
Setlength(s,1000)
for i:=1 to 1000 do s[i]:='*';
Хотя оба кода делают одно и тоже, но при увеличении строки первый код начинает подтормаживать. причина - постоянное копирование строки.
И хотя это жутко утрированный пример, но он в том или ином подобии появляется в разных примерах.
Второй причиной может быть то, что библиотека не расчитана на такие объёмы. тоесть при таких объемах данных может не совсем правильно заполнятся внутринее структуры, неправильно срабатывать оптимизация, которая хорошо работала на маленьких объема.

Есть альтернативная, бесплатная библиотека http://www.delphilab.ru/content/view/72/73/
скорость достаточно приличная (на 2ГГц даёт до мегабайта в секунду на распаковку)
Работает достаточно хорошо

Ответ отправил: Вадим К (статус: Академик)
Время отправки: 3 октября 2007, 16:22
Оценка за ответ: 4

Ответ #2. Отвечает эксперт: Feniks

Здравствуйте, Popovich E.V.!
Сегодня в инете встретил книгу "Методы сжатия данных. Устройство архиваторов, сжатие изображений и видео" по этому адресу http://ru-admin.net/2007/10/03/metody-szhatija-dannykh.-ustrojjstvo.html
А кто Вам мешает использовать уже существующие архиваторы ? Ведь они все поддерживают работу с командной строкой, например RAR. Он есть и консольный. Консольным с помощью параметров командной строки пакует, а для распаковки используете его библиотеку unrar.dll Пример ее использования см. в Приложении.
Еще попробуйте пару компонентов http://depositfiles.com/files/1951946

Приложение:
  1. function RAROpenArchive(ArchiveData : Pointer): Integer; stdcall;
  2. external 'unrar.dll' name 'RAROpenArchive';
  3.  
  4. function RARCloseArchive(hArcData : Integer): Integer; stdcall;
  5. external 'unrar.dll' name 'RARCloseArchive';
  6.  
  7. function RARReadHeader(hArcData : Integer; HeaderData : Pointer): Integer; stdcall;
  8. external 'unrar.dll' name 'RARReadHeader';
  9.  
  10. function RARProcessFile(hArcData : Integer; Operation : Integer; DestPath : Pointer;
  11. DestName : Pointer): Integer; stdcall;
  12. external 'unrar.dll' name 'RARProcessFile';
  13.  
  14.  
  15. const
  16.  
  17. ERAR_END_ARCHIVE = 10;
  18. ERAR_NO_MEMORY = 11;
  19. ERAR_BAD_DATA = 12;
  20. ERAR_BAD_ARCHIVE = 13;
  21. ERAR_UNKNOWN_FORMAT = 14;
  22. ERAR_EOPEN = 15;
  23. ERAR_ECREATE = 16;
  24. ERAR_ECLOSE = 17;
  25. ERAR_EREAD = 18;
  26. ERAR_EWRITE = 19;
  27. ERAR_SMALL_BUF = 20;
  28.  
  29. RAR_OM_LIST = 0;
  30. RAR_OM_EXTRACT = 1;
  31. RAR_SKIP = 0;
  32. RAR_TEST = 1;
  33. RAR_EXTRACT = 2;
  34. RAR_VOL_ASK = 0;
  35. RAR_VOL_NOTIFY = 1;
  36.  
  37.  
  38. type
  39.  
  40. Char260 = Array [1..260] of Char;
  41.  
  42.  
  43. TRAROpenArchiveData = record
  44.  
  45. OpenMode : Cardinal;
  46. OpenResult : Cardinal;
  47. CmtBuf : PChar;
  48. CmtBufSize : Cardinal;
  49. CmtSize : Cardinal;
  50. CmtState : Cardinal;
  51. end;
  52.  
  53.  
  54.  
  55. TRARHeaderData = record
  56. ArcName : Char260;
  57. FileName : Char260;
  58. Flags : Cardinal;
  59. PackSize : Cardinal;
  60. UnpSize : Cardinal;
  61. HostOS : Cardinal;
  62. FileCRC : Cardinal;
  63. FileTime : Cardinal;
  64. UnpVer : Cardinal;
  65. Method : Cardinal;
  66. FileAttr : Cardinal;
  67. CmtBuf : PChar;
  68. CmtBufSize : Cardinal;
  69. CmtSize : Cardinal;
  70. CmtState : Cardinal;
  71. end;
  72.  
  73.  
  74. var
  75.  
  76. RARExtract : boolean;
  77. RAROpenArchiveData : TRAROpenArchiveData;
  78. RARComment : array [1..256] of Char;
  79. RARHeaderData : TRARHeaderData;
  80.  
  81.  
  82. ...
  83.  
  84.  
  85. procedure ExtractRARArchive;
  86. var
  87. sDir : string;
  88. s : string;
  89. sTest : string;
  90. iTest : integer;
  91. bTestDone : boolean;
  92. RARhnd : Integer;
  93. RARrc : Integer;
  94. PDestPath : Char260;
  95.  
  96. begin
  97. RARExtract:=TRUE;
  98. lKBWritten:=0;
  99. ProgressBar2.Position := 0;
  100. ProgressBar2.Max := lTotalSize;
  101. RARStartTime:=Time;
  102.  
  103. RAROpenArchiveData.OpenResult:=99;
  104.  
  105. RAROpenArchiveData.ArcName:= @RARFileName;
  106. RAROpenArchiveData.CmtBuf := @RARComment;
  107. RAROpenArchiveData.CmtBufSize := 255;
  108.  
  109.  
  110. RARhnd := RAROpenArchive (@RAROpenArchiveData);
  111. If RAROpenArchiveData.OpenResult <> 0 then
  112. begin
  113. case RAROpenArchiveData.OpenResult of
  114. ERAR_NO_MEMORY : s:='Not enough memory to initialize data structures';
  115. ERAR_BAD_DATA : s:='Archive header broken';
  116. ERAR_BAD_ARCHIVE : s:='File is not valid RAR archive';
  117. ERAR_EOPEN : s:='File open error';
  118. end;
  119. MessageDlg('Unable to open rar archive: ' + s + '!',mtError, [mbOK], 0);
  120. end;
  121.  
  122. RARSetProcessDataProc(RARhnd,@Form.OnRarStatus);
  123. StrPCopy(@PDestPath, EInstallPath.Text);
  124.  
  125. repeat
  126.  
  127. if RARrc <> ERAR_END_ARCHIVE then
  128. begin
  129. ProgressBar1.Position := 0;
  130. ProgressBar1.Max := RARHeaderData.UnpSize;
  131. s:=RARHeaderData.FileName;
  132. lblCurrentFile.Caption := s;
  133. lKBytesDone := 0;
  134. end;
  135.  
  136. if RARrc = 0 then
  137. RARrc:=RARProcessFile (RARhnd, RAR_EXTRACT, @PDestPath, nil);
  138. if (RARrc <> 0) and (RARrc <> ERAR_END_ARCHIVE) then
  139. begin
  140. MessageDlg('An Error occured during extracting of ' + sTest+'!' + #13#10 +
  141. 'RARProcessFile: ' + MakeItAString(RARrc),mtError, [mbOK], 0);
  142. end;
  143. until RARrc <> 0;
  144.  
  145.  
  146. If RARCloseArchive(RARhnd) <> 0 then
  147. begin
  148. MessageDlg('Unable to close rar archive!',mtError, [mbOK], 0);
  149. end;
  150. end; // ExtractRARArchive


Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 3 октября 2007, 16:39

Ответ #3. Отвечает эксперт: min@y™

Зайди-ка вот сюды. Там есть куча того, что тебе надо.

Ответ отправил: min@y™ (статус: Доктор наук)
Время отправки: 3 октября 2007, 16:50

Ответ #4. Отвечает эксперт: Помфюк Владимир Степанович

Здравствуйте, Popovich E.V.!
В Вашем примере совершенно непонятно зачем используется TMemoryStream. Возможно при болших обьёмах именно он и "тормозит процесс". Попробуйте так (в приложении). У меня работает, правда, с алгоритмом упаковки bz2 (BZip2 unit by Edison Mera, окуда качал не помню).

Приложение:
  1.  
  2.  
  3. zs:TCompressionStream;
  4. ifl,ofl:TFileStream;
  5. begin
  6. ifl:=TFileStream.Create(InFileName,fmOpenRead);
  7. ofl:=TFileStream.Create(OutFileName,fmCreate or fmOpenReadWrite);
  8. zs:=TCompressionStream.Create(CompressionLefel,ofl);
  9. zs.CopyFrom(ifl,ifl.Size);
  10. ifl.Destroy;
  11. zs.Destroy;
  12. ofl.Destroy;
  13. end
  14.  
  15.  


Ответ отправил: Помфюк Владимир Степанович (статус: Абитуриент)
Время отправки: 4 октября 2007, 10:24


Мини-форум вопроса

Всего сообщений: 1; последнее сообщение — 3 октября 2007, 16:45; участников в обсуждении: 1.
Feniks

Feniks (статус: Бакалавр), 3 октября 2007, 16:45 [#1]:

В догонку, зыбал вставить...

В Delphi 7 официально включена поддержка библиотеки сжатия ZLib. Если у вас более старшая версия посмотрите модули ZLib в дестрибутиве среды (они должны быть на диске но подключать прийдеться самому).

Библиотеки под разные платформы, среды разработок и документация на сайте www.gzip.org/zlib.

Степень сжатия превосходит алгоритм zip. Максимальная степень сжатия по алгоритму ZLib приближается к степени сжатия упаковщиком RAR.

Модули Zlib, ZlibConst.

При использовании необходимо подключить в описании Uses модуль ZLib.

пример использования:

Компресия одного потока в другой:

ComressStream( aSource, aTarget : TStream; compressionRate : TCompressionLevel );
var comprStream : TCompressionStream;
begin
// compression level : (clNone, clFastest, clDefault, clMax)
comprStream := TCompressionStream.Create( compressionRate, aTarget );
try
comprStream.CopyFrom( aSource, aSource.Size );
comprStream.CompressionRate;
finally
comprStream.Free;
End;
End;

Декомпресия одного потока в другой:

DecompressStream(aSource, aTarget: TStream);
var decompStream : TDecompressionStream;
nRead : Integer;
buffer : array[0..1023] of Char;
begin
decompStream := TDecompressionStream.Create( aSource );
try
repeat
nRead:=decompStream.Read( buffer, 1024 );
aTarget.Write( buffer, nRead );
Until nRead = 0;
finally
decompStream.Free;
End;
End;

P.S. ©Drkb::03193 / Взято из http://forum.sources.ru

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 31 октября 2025, 07:15
Выполнено за 0.03 сек.