» Упаковка папок c помощью ZLib. Borland Delphi. . . Блог программистов


Блог программистов






200723 Апр

Упаковка папок c помощью ZLib.

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

Первые четыре байта будет составлять сигнатура, которая будет обозначать, что это файл нашего формата
Следующие четыре байта будут обозначать количество файлов в этом склеенном файле
Потом будет идти массив структур, который будет описывать все файлы в этом склеенном файле, каждая структура будет иметь вот такой формат

1. 2 байта — длина имени файла
2. Размер этого поля равен значению предыдущего поля — Полное имя файла, исключая путь к нашей папке, т.е. путь к файлу в нашей папке.
3. 4 байта — Размер файла
4. Размер этого поля равен значению предыдущего поля — Само содержание файла

В данной структуре максимальный размер одного файла может быть максимум 2^32 байт, т.е. 4 ГБ. Кстати, для повышения вышей образованности формат сохранения строки, который я использую, называется LS, т.е. сначала пишется длина стоки потом сама строка. Итак, приступим к кодингу. Сначала нам надо получить список всех файлов в папке. Напишем функцию, которой мы будем передавать путь к папке, а она нам будет возвращать объект TStringList в котором и будет лежать список всех файлов в папке.


function GetAllFiles (Filter, Folder: string):TFilesList;
var
  sr: TSearchRec;
  sDirList,_FilesList,_LST: TStringList;
  i,j: Integer;
begin
  j:=0;
  _FilesList:= TStringList.create;
  _FilesList.Clear;

В начале мы создаём объект результат , а потом мы ищем все файлы которые находятся в папке путь к которой был передан в качестве второго параметра. Я думаю здесь нет ничего сложного. Первые два найденных файла игнорируются потому что это папки . и .. при переходе на которых мы остаёмся в этой папке и переходим на один уровень вверх соответственно.


  if FindFirst (Folder + Filter,faAnyFile , sr) = 0 then
  repeat
    j:=j+1;
    if j<3 then Continue;
    if (sr.Attr and fadirectory)=faDirectory then Continue;
    _FilesList.Add(Folder + sr.Name);
  until FindNext(sr)  0;
  FindClose(sr);

Далее мы создаём объект, в котором будет храниться список подпапок, и вызываем для каждой подпапки саму себя. Здесь немного по-другому игнорируются первые два пункта я это сделал только лишь для разнообразия (кстати, так намного лучше, чем то что мы применяли при поиске файлов). После получения списка файлов в каждой подпапке мы копируем полученный список в список результат.


  sDirList := TStringList.Create;
  try
    GetSubDirs (Folder, sDirList);
    for i := 0 to sDirList.Count - 1 do
      if (sDirList  '.') and (sDirList  '..') then
      begin
        _LST:=GetAllFiles(Filter,IncludeTrailingPathDelimiter (Folder + sDirList));
        for j:=0 to _LST.Count-1 do
         _FilesList.Add(_LST.Strings[j]);
        _LST.free;
      end;
  finally
    sDirList.Free;
  end;
  Result:= _FilesList;
end;

В этой функции мы применяли способ вызова функции из самой себя, настоятельно не рекомендую использовать такой способ при выполнении операций требующих очень большого количества вызовов функции, так как это может вызвать переполнение стека. В Windows стек ограничен 1 МВ. Поэтому функция (если у неё один параметр) может вызвать себя только 131072 раз, вы скажете «столько раз вызвать саму себя невозможно». А если у функции 5 параметров то 1048576/(6*4) = 34952. А это уже не очень много. Вы спросите, зачем нам нужен параметр, который задаёт фильтр, я отвечу «просто так», мало ли что, может пригодиться. Ах да забыл привести процедуру получения списка подпапок. Лист с результатом можно было возвращать в качестве результата, но для разнообразия это тоже не помешает.


procedure GetSubDirs (Folder: string; sList: TStringList);
var
  sr: TSearchRec;
begin
  if FindFirst (Folder + '*.*', faDirectory, sr) = 0 then
  try
    repeat
      if (sr.Attr and faDirectory) = faDirectory then
        sList.Add (sr.Name);
    until FindNext(sr)  0;
  finally
    FindClose(sr);
  end;
end;

Едем далее… после получения списка файлов нам надо все эти файлы склеить в один. Я специально пойду, не так как говорил в начале. Будем делать так: нашей функции будет передаваться функция которая будет делать с файлом некоторое действие которое нужно вам. Заголовок функции будет такой

type
TActionFuntion = function(SourceFileName, DestFileName: string):boolean;

Результат функции будет обозначать успешность действия. Сейчас вам, конечно же, ничего не понятно, сейчас всё поймёте. Функции упаковки папки будет передаваться папка, файл результат и функция обратного вызова, которая будет вызываться для каждого файла в этой папке. В общем, вот код этой функции


function DoFolderAction;
var
  ArchiveFile,CurrFile:THandle;
  Value,i,CurrFileSize,_readed,_writed:DWORD;
  _Files:TStringList;
  path_in_archive_file:string;
  pBuff:Pointer;
begin
  Result:=false;
  if FolderPath[Length(FolderPath)]'\' then
   FolderPath:=FolderPath+'\';

  _Files:=GetAllFiles('*.*',FolderPath);

  ArchiveFile:=CreateFile(pchar(ArchivePath), GENERIC_READ+GENERIC_WRITE, FILE_SHARE_READ,0, CREATE_ALWAYS,0,0);

  Value:=ArchiveSignature;
  WriteFile(ArchiveFile,value,4,_writed,0);//write main archive signature
  Value:=_Files.Count;
  WriteFile(ArchiveFile,value,4,_writed,0);//write files count

  for i:=0 to value-1 do
   begin

Далее мы вызываем функцию обратного вызова, которой передаём файл источник и файл результат, файл-результат это всего лишь промежуточный файл, потом мы его удалим. Переменную bkpFile можно объявить как константу.


    if not ActionFunction(_Files.Strings,bkpFile) then
     begin
{если функция обратного вызова завершилась неудачно, выходим из функции, если это не нужно то можно этот код закоментарить, но тогда наша функция будет завершаться удачно даже если какой то файл не был обработан }
      CloseHandle(ArchiveFile);
      exit;
     end;
    CurrFile:=CreateFile(pchar(bkpFile),GENERIC_READ,FILE_SHARE_READ,0,OPEN_EXISTING,0,0);
    CurrFileSize:=GetFileSize(CurrFile,nil);
    path_in_archive_file:=copy(_Files.Strings,length(FolderPath),1000);// XA XA XA XA XA
    if path_in_archive_file[1] = '\' then
     Delete(path_in_archive_file,1,1);
    Write_LS(ArchiveFile,path_in_archive_file);
    WriteFile(ArchiveFile,currFileSize,4,_writed,0);
    pBuff:=VirtualAlloc(0,MainBufferSize,MEM_COMMIT+MEM_RESERVE,PAGE_READWRITE);

    repeat
     ReadFile(CurrFile,pBuff^,MainBufferSize,_readed,0);
     WriteFile(ArchiveFile,pBuff^,_readed,_writed,0);
    until _writed<MainBufferSize;

    VirtualFree(pBuff,MEM_RELEASE,0);

    CloseHandle(CurrFile);
    DeleteFile(bkpFile);
   end;

  CloseHandle(ArchiveFile);
  Result:=True;
end;

Теперь приведу функцию, которая распаковывает всё это дело. Полный код функции смотрите в исходнике.


function De_DoFolderAction (FolderPath, ArchivePath :string; DeActionFunction :TActionFuntion) :boolean;
var
………
begin
 ArchiveFile := CreateFile(pchar(ArchivePath), GENERIC_READ+GENERIC_WRITE, FILE_SHARE_READ,0,OPEN_EXISTING,0,0);
 ReadFile(ArchiveFile,value,4,_readed,0); {проверяем наш ли это формат}
 if Value ArchiveSignature then
  begin
………
  end;
 ReadFile(ArchiveFile,_Count,4,_readed,0); {получаем количество файлов}
 for i:=1 to _Count do
  begin
   path_in_archive_file := Read_LS(ArchiveFile);
   ReadFile(ArchiveFile,CurrFileSize,4,_readed,0);
………
   for j:=1 to CurrFileSize div MainBufferSize do
    begin
     ReadFile(ArchiveFile,pBuff^,MainBufferSize,_readed,0);
     WriteFile(CurrFile,pBuff^,_readed,_writed,0);
    end;
   ReadFile(ArchiveFile, pBuff^, CurrFileSize mod MainBufferSize, _readed,0);
   WriteFile(CurrFile,pBuff^,_readed,_writed,0);
………
   if FolderPath[Length(FolderPath)]'\' then Delete(FolderPath,Length(FolderPath),1);
   if path_in_archive_file[1]'\' then path_in_archive_file := '\' + path_in_archive_file;
   path_in_archive_file :=FolderPath+path_in_archive_file;
   makedir(ExtractFileDir(path_in_archive_file));
{код этой функции тоже смотрите  в исходнике}
   if not  DeActionFunction(bkpfile,path_in_archive_file) then
    begin
………
    end;
………
  end;
………
end;

Теперь для того чтобы просто склеить все файлы в папке в один файл надо сделать это:

function DODO(fl1,fl2:string):boolean;
begin
  Result:=CopyFile(pchar(fl1),pchar(fl2),false);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 DoFolderAction('F:\111','F:\arch.dat',DODO);  
 De_DoFolderAction('F:\112','F:\arch.dat',DODO);
end

Для того чтобы упаковать папку, используя функции, описанные мной в предыдущей статье, надо сделать так:


function DODO2(fl1,fl2:string):boolean;
begin
 Result:=ZLATCompressFile(fl1,fl2,2,false,true,nil,0,0) <> 0;
end;

function DODO3(fl1,fl2:string):boolean;
begin
 Result:=ZLATdecompressfile(fl1,fl2,false,true,nil,0,0);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 DoFolderAction('F:\111\','F:\arch.dat',DODO2);
 De_DoFolderAction('F:\112\','F:\arch.dat',DODO3)
end;

Конечно, можно было сначала склеить все файлы, потом сжать склеенный файл, а для распаковки сначала распаковать и потом расклеить. С тем же успехом можно шифровать целые папки, используя технологию шифровки которые я описал в своих предыдущих статье и статье. Короче кидаете файл FolderActions.pas в расшаренную для Delphi папку и пользуетесь модулем на здоровье.
Вот, пожалуй, и всё.
Модуль для упаковки папок
архив с исходниками к предыдущей статье

Комментарии

  1. Андрей
    Апрель 28th, 2007 | 13:15

    Процесс получения списка файлов неоптимизирован.
    Есть другой вариант, намного быстрее.

    // DirPath должна заканчиваться на \
    procedure GetFiles(const DirPath, FileExt: String; FileList: TStringList);
    var Status: THandle;
    FindData: TWin32FindData;
    begin
    Status := FindFirstFile(PChar(DirPath + FileExt), FindData);
    if Status INVALID_HANDLE_VALUE then
    try
    repeat
    with FindData do
    if (cFileName[0] '.') and (cFileName '..') then
    if dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY 0 then
    GetFiles(DirPath + cFileName + '\', FileExt, FileList) // получаем файлы в дочерней папке
    else
    FileList.Add(DirPath + cFileName); // добавляем в список полный путь к файлу
    // FileList.Add(cFileName); // или только имя файла
    until not FindNextFile(Status, FindData);
    finally
    Windows.FindClose(Status);
    end;
    end;

    Использование:

    var FileList: TStringList;
    begin
    FileList := TStringList.Create;
    try
    GetFiles('C:\Windows\', '*.exe', FileList);
    GetFiles('C:\Windows\', '*.dll', FileList);
    GetFiles('C:\Windows\', '*.ini', FileList);
    ShowMessage(FileList.Text);
    // здесь юзаем полученный список
    finally
    FileList.Free;
    end;
    end;

  2. rpy3uH
    Май 21st, 2007 | 19:06

    я лишь показал как можно упаковать целую папку, целью этой статьи не было написание быстрого алгоритма поиска

    спасибо за алгоритм!!!!

  3. Vlad
    Июнь 13th, 2007 | 16:05

    Для интереса. С помощью ZLib можно упаковать в ZIP-формат версии 2.0, добавив нужные заголовки к упакованным ZLib данным. Поскольку даже последний WinZip 11 по умолчанию для совместимости использует формат ZIP 2.0, то с помощью ZLib также можно распаковать архивы, созданные в WinZip (если в WinZip специально не была выбрана сильная степень сжатия или сжатие с паролем).
    Например, на torry.ru есть ряд компонентов, в которых это реализовано, самый простой, на мой взгляд, — SciZipFile.pas

  4. AHTOLLlKA
    Апрель 23rd, 2009 | 18:06

    function DODO2(fl1,fl2:string):boolean;
    begin
    Result:=ZLATCompressFile(fl1,fl2,2,false,true,nil,0,0);
    end;

    у DODO2 результ boolean а
    у ZLATCompressFile результ integer

    и поэтому ошика вылазит как избежать этого???

  5. rpy3uH
    Апрель 23rd, 2009 | 18:46

    в статье была ошибка, теперь всё нормально
    надо так

    function DODO2(fl1,fl2:string):boolean;
    begin
    Result:=ZLATCompressFile(fl1,fl2,2,false,true,nil,0,0) <>0;
    end;

  6. Dasya_
    Май 5th, 2009 | 18:39

    При распаковке возникает ошибка в функции открытия раннее созданного файла CreateFile, код ошибки — 6: Err_Bad_Handle. Что влекет за собой чтение из несуществующего файла, как мне кажется. Кто-нибудь сталкивался с этой проблемой? Помогите пожалуйста!

  7. rpy3uH
    Май 21st, 2009 | 17:30

    для получения адекватного ответа лучше задать этот вопрос на форуме

  8. человек
    Октябрь 27th, 2011 | 12:12

    конечно это не zip-файл, плюс еще не распаковывается исходниками к статье. а может есть способ использовать zipfldr.dll в среде Delphi?

  9. rpy3uH
    Апрель 20th, 2012 | 14:54

    возможно есть. в этой статье изложен свой формат создания архива папки