paszlib/ru

From Free Pascal wiki
Revision as of 14:47, 8 June 2021 by Zoltanleo (talk | contribs) (Zipping a whole directory tree storing only a relative path)

Deutsch (de) English (en) 한국어 (ko) polski (pl) русский (ru)

paszlib представляет собой преобразование стандартной библиотеки zlib на Паскаль: вам не нужны никакие внешние зависимости. Его реализовал Jacques Nomssi Nzali (его старая домашняя страница мертва, см. продолжение проекта здесь). Он используется в FCL для реализации класса TCompressionStream.

Этот класс позволяет сжимать и распаковывать файлы .zip.

Основной модуль этого пакета - paszlib. Существуют и другие вспомогательные модули, но единственный модуль, который необходимо включить в типичную программу, - этот.

TZipper

TZipper поддерживает сжатие и распаковку файлов .zip, но не поддерживает все методы сжатия zip.

Документация

См. официальную документацию FPC для Zipper

Примеры

Упаковка файлов

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

zipper newzip.zip autoexec.bat config.sys
uses
  Zipper;
var
  OurZipper: TZipper;
  I: Integer;
begin
  OurZipper := TZipper.Create;
  try
    // Опредяем имя создаваемого zip-файла.
    OurZipper.FileName := ParamStr(1);
    for I := 2 to ParamCount do
      // В качестве первого аргумента указываем имена файлов, которые будут включены в zip-архив.
      // Второй аргумент - это имя файла в том виде, в котором оно отображается в zip-архиве, и
      // позже в файловой системе после распаковки
      OurZipper.Entries.AddFileEntry(ParamStr(I), ParamStr(I));
    // Выполняем операцию архивирования и записываем архивный файл.
    OurZipper.ZipAllFiles;
  finally
    OurZipper.Free;
  end;
end.

Обратите внимание, что имена архивируемых файлов должны содержать только символы из старого набора символов IBM PC (кодовая страница 437). Расширенные символы (UTF-8) см. в разделе ниже.

Распаковка файлов

Распаковываем все файлы из архива c:\test.zip в папку c:\windows\temp\

uses
  Zipper;
var
  UnZipper: TUnZipper;
begin
  UnZipper := TUnZipper.Create;
  try    
    UnZipper.FileName := 'c:\test.zip';
    UnZipper.OutputPath := 'c:\windows\temp';
    UnZipper.Examine;
    UnZipper.UnZipAllFiles;
  finally
    UnZipper.Free;
  end;
end.

Упаковка файлов с сохранением кодировки имен файлов

Как уже отмечалось, формат файла zip изначально был написан для поддержки только кодовой страницы 437 IBM PC. Однако в современных операционных системах кодировка имен файлов является гораздо более общей.

Если у вас версия FPC 3.2 или новее, вы можете воспользоваться логическим свойством UseLanguageEncoding. Если установлено значение true, предполагается, что имена файлов имеют кодировку по умолчанию FPC, в случае программ Lazarus это UTF-8. Здесь в zipper можно передать любое имя файла (за исключением, конечно, ограничений ОС).

В следующей практической программе для FPC 3.2 из файлов в заданном каталоге создается zip-файл, чтобы имена файлов считались правильными:

uses
  FileUtil, zipper;

function PackFiles(AZipFilename, ADirectory, AMask: String;
  IncludingSubDirs: Boolean): Boolean;
var
  OurZipper: TZipper;
  list: TStringList;
  i: Integer;
  diskFileName, archiveFileName: String;
begin
  Result := false;
  ADirectory := IncludeTrailingPathDelimiter(ADirectory);
  if DirectoryExists(ADirectory) then
  begin
     OurZipper := TZipper.Create;
     try
       // Задаем имя создаваемого zip-файла
       OurZipper.FileName := AZipFileName;

       // Считываем имена файлов, содержащихся в ADirectory, в stringlist
       list := TStringList.Create;
       try
         // FindAllFiles добавляет все имена файлов, соответствующие маске (например, '*.*'),
         // найденных в указанном каталоге в предоставленный список.
         // Если IncludingSubDirs - true, поиск продолжается рекурсивно и в
         // подкаталогах.
         FindAllFiles(list, ADirectory, AMask, IncludingSubDirs);
         for i := 0 to list.Count - 1 do
         begin
           // diskfilename - это имя файла, который будет заархивирован на диске
           diskFileName := list[i];
           // archivefilename - это имя файла, который нужно заархивировать, как он выглядит
           // в zip. Убираем директорию из
           archiveFileName := StringReplace(diskFileName, ADirectory, '', []);
           // Сохраняем эти файлы для архиватора
           OurZipper.Entries.AddFileEntry(diskFileName, archiveFileName);
         end;
       finally
         list.Free;
       end;
       // По умолчанию архиватор записывает имена файлов в кодировке IBM PC CP437.
       // Кодировка UTF8 записывается, когда UseLanguageEncoding - true.
       OurZipper.UseLanguageEncoding := true;  // Требуется FPC 3.2+
       // создаем и записываем zip-файл
       OurZipper.ZipAllFiles;
       Result := true;
     finally
       OurZipper.Free;
     end;
  end else
    Result := false;
end;

Если у вас версия FPC меньше v3.2, вы должны преобразовать аргумент ArchiveFileName в CP437 - конечно, это возможно не для всех символов, и поэтому вы должны быть очень осторожны с архиватором в этом случае. Также обратите внимание, что DiskFileName должен иметь кодировку, требуемую операционной системой, иначе файл для архивирования не будет найден; в случае FPC до 3.0 может потребоваться еще одно преобразование кодовой страницы.

Вот адаптация приведенного выше примера для версии FPC до 3.2:

uses
  FileUtil, LConvEncoding, LazUTF8, Zipper;

function PackFiles(AZipFilename, ADirectory, AMask: String;
  IncludingSubdirs: Boolean): Boolean;
var
  OurZipper: TZipper;
  list: TStringList;
  i: Integer;
  diskFileName, archiveFileName: String;
begin
  Result := false;
  if AMask = '' then AMask := '*.*';
  ADirectory := IncludeTrailingPathDelimiter(ADirectory);
  if DirectoryExists(ADirectory) then
  begin
     OurZipper := TZipper.Create;
     try
       OurZipper.FileName := AZipFileName;
       list := TStringList.Create;
       try
         // Перечислияем все файлы в ADirectory и, если необходимо, его подкаталоги.
         FindAllFiles(list, ADirectory, AMask, IncludingSubDirs);
         for i := 0 to list.Count-1 do
         begin
           // Имя файла, который нужно заархивировать на диске
           diskFileName := list[i];
           {$IF FPC_FullVersion < 30000}
           diskFileName := UTF8ToWinCP(diskFileName);
           {$IFEND}
           // Имя файла, который нужно заархивировать в архиве: убираем
           // общий путь и таким образом обозначаем файлы относительно каталога
           // в который они будут распакованы позже.
           archiveFileName := StringReplace(list[i], ADirectory, '', []);
           archiveFileName := UTF8ToCP437(archiveFileName);
           OurZipper.Entries.AddFileEntry(diskFileName, archiveFileName);
         end;
       finally
         list.Free;
       end;
       // Выполняем действие архивирования и создаем архивный файл.
       OurZipper.ZipAllFiles;
       Result := true;
     finally
       OurZipper.Free;
     end;
  end;
end;

Еще одно ограничение - это разделитель пути в имени заархивированного файла. Спецификация формата zip требует, чтобы косая черта (слэш) ('/') использовалась даже в случае Windows. Это важно для однопараметрической перегрузки TZipper.Entries.AddFileEntry(DiskfileName), которая просто предполагает, что имя заархивированного файла равно DiskFileName, без каких-либо адаптаций. Следовательно, такой zip-файл будет содержать обратный слэш в Windows. Он будет правильно распакован в Windows, но не в Linux, где обратный слэш считается допустимым символом имени файла. Настоятельно рекомендуется использовать двухпараметрическую версию TZipper.Entries.AFileEntry(DiskFileName, ArchiveFileName) с ArchivefileName = DiskFileName, поскольку эта процедура автоматически заменяет разделители путей по мере необходимости.

Распаковка файлов с сохранением кодировки имен

uses
  Zipper, LConvEncoding;
...
function EndPathCP866ToUTF8(AText:string):string;
var
  c,i:integer;
  s,s1,s2,chr:string;
begin
  s:='';
  c:=UTF8Length(AText);
  for i:=c downto 1 do
  begin
       chr:=UTF8Copy(AText,i,1);
       if ((not(chr='/')) and (not(chr='\')))or(i=c) then
       begin
            s:=UTF8Copy(AText,i,1)+s;
       end
       else begin
            s:=UTF8Copy(AText,i,1)+s;
            break;
       end;
  end;
  dec(i);
  s1:=UTF8Copy(AText,1,i);
  s2:=CP866ToUTF8(s);
  Result:=s1+s2;
end;

function UnPackFiles(Filename, UnPackPath: String): Integer;
var
  UnZipper          :TUnZipper; //PasZLib
  UnPackFileDir,
  ADiskFileName,
  ANewDiskFileName,
  AArchiveFileName  :String;
  i                 :integer;
begin
  Result:=-1;
  if FileExists(Filename)and DirectoryExists(UnPackPath) then
  begin
       UnPackFileDir :=SysUtils.IncludeTrailingPathDelimiter(UnPackPath);
       UnZipper      :=TUnZipper.Create;
       try
          UnZipper.FileName   := Filename;
          UnZipper.OutputPath := UnPackPath;
          UnZipper.Examine;
          UnZipper.UnZipAllFiles;

          for i:=UnZipper.Entries.Count-1 downto 0 do
          begin
              AArchiveFileName:=UnZipper.Entries.Entries[i].ArchiveFileName;
              AArchiveFileName:=EndPathCP866ToUTF8(AArchiveFileName);
              AArchiveFileName:=UTF8ToSys(AArchiveFileName);
              ANewDiskFileName:=UnPackFileDir+AArchiveFileName;
              ADiskFileName   :=UnPackFileDir+UnZipper.Entries.Entries[i].DiskFileName;

              if FileExists(ADiskFileName) then
              begin
                 RenameFile(ADiskFileName, ANewDiskFileName);
              end
              else if DirectoryExists(ADiskFileName) then
              begin
                 ADiskFileName    :=SysUtils.IncludeTrailingPathDelimiter(ADiskFileName);
                 ANewDiskFileName :=SysUtils.IncludeTrailingPathDelimiter(ANewDiskFileName);
                 RenameFile(ADiskFileName, ANewDiskFileName);
              end;
          end;

          Result:=1;
       finally
          UnZipper.Free;
       end;
  end;
end;

Дополнительные примеры можно найти в исходном каталоге FPC:

  • примеры: [1]
  • тестовые программы: [2]

Распаковка файла в поток (память)

В Lazarus поместите в форму TMemo, TButton, TEdit и TFileNameEdit. Нажатие кнопки приведет к чтению zip-файла в FileNameEdit, извлечению файла, указанному в поле Edit, и отображению содержимого в Memo.

uses
  Zipper;

...

procedure TForm1.Button1Click(Sender: TObject);
begin
  ExtractFileFromZip(FileNameEdit1.FileName,Edit1.Text);
end;

procedure TForm1.DoCreateOutZipStream(Sender: TObject; var AStream: TStream;
  AItem: TFullZipFileEntry);
begin
  AStream:=TMemorystream.Create;
end;

procedure TForm1.DoDoneOutZipStream(Sender: TObject; var AStream: TStream;
  AItem: TFullZipFileEntry);
begin
  AStream.Position:=0;
  Memo1.lines.LoadFromStream(Astream);
  Astream.Free;
end;

procedure TForm1.ExtractFileFromZip(ZipName, FileName: string);
var
  ZipFile: TUnZipper;
  sl:TStringList;
begin
  sl:=TStringList.Create;
  sl.Add(FileName);
  ZipFile := TUnZipper.Create;
  try
    ZipFile.FileName := ZipName;
    ZipFile.OnCreateStream := @DoCreateOutZipStream;
    ZipFile.OnDoneStream:=@DoDoneOutZipStream;
    ZipFile.UnZipFiles(sl);
  finally
    ZipFile.Free;
    sl.Free;
  end;
end;

Архивирование всего дерева каталогов

  • Этот пример рекурсивно добавит содержимое 'C: MyFolder' в 'myzipfile.zip'
    • Обратите внимание, что в zip-файле абсолютный путь сохраняется.
    • Обратите внимание, что для этого требуется модуль Lazarus fileutil (который, вероятно, можно обойти)
Uses ...Zipper,FileUtil
var
  AZipper: TZipper;
  TheFileList:TStringList;
begin
  MyDirectory:='C:\MyFolder';
  AZipper := TZipper.Create;
  AZipper.Filename := 'myzipfile.zip';
  TheFileList:=TStringList.Create;
  try
    FindAllFiles(TheFileList, MyDirectory);
    AZipper.Entries.AddFileEntries(TheFileList);
    AZipper.ZipAllFiles;
  finally
    TheFileList.Free;
    AZipper.Free;
  end;
end;

Архивирование всего дерева каталогов с сохранением только относительного пути

  • Это сложнее, но это можно сделать
    • Обратите внимание, что для этого требуется модуль Lazarus fileutil (который, вероятно, можно обойти)
Uses ...Zipper,FileUtil,strutils
var
  AZipper: TZipper;
  szPathEntry:String;
  i:Integer;
  ZEntries : TZipFileEntries;
  TheFileList:TStringList;
  RelativeDirectory:String;
begin
  AZipper := TZipper.Create;
  try
    try
      AZipper.Filename := 'myzipfile.zip';
      RelativeDirectory:='C:\MyFolder\MyFolder\';
      AZipper.Clear;
      ZEntries := TZipFileEntries.Create(TZipFileEntry);
      // Проверяем существование каталога
      If DirPathExists(RelativeDirectory) then
      begin
        // Создаем путь к каталогу НИЖЕ RelativeDirectory.
        // If user specifies 'C:\MyFolder\Subfolder' it returns 'C:\MyFolder\'
        // If user specifies 'C:\MyFolder' it returns 'C:\'
        // If user specifies 'C:\' it returns 'C:\'
        i:=RPos(PathDelim,ChompPathDelim(RelativeDirectory));
        szPathEntry:=LeftStr(RelativeDirectory,i);

        // Use the FileUtils.FindAllFiles function to get everything (files and folders) recursively
        TheFileList:=TstringList.Create;
        try
          FindAllFiles(TheFileList, RelativeDirectory);
          for i:=0 to TheFileList.Count -1 do
          begin
            // Make sure the RelativeDirectory files are not in the root of the ZipFile
            ZEntries.AddFileEntry(TheFileList[i],CreateRelativePath(TheFileList[i],szPathEntry));
          end;
        finally
          TheFileList.Free;
        end;
      end;
      if (ZEntries.Count > 0) then
        AZipper.ZipFiles(ZEntries);
      except
        On E: EZipError do
          E.CreateFmt('Zipfile could not be created%sReason: %s', [LineEnding, E.Message])
      end;
    result := True;
  finally
    FreeAndNil(ZEntries);
    AZipper.Free;
  end;  
end;

Note that this example uses an overloaded version of addfileentry() (compared to simple examples). This version allows you to specify the directory structure inside the Zip file, and, then, of course, the directory structure when its all unzipped. You can, for example, specify only the file name with no directory structure and have all files returned in one flat output directory. Even if they came for all over the place !

ZEntries.AddFileEntry(FullDiskPathToFile, FileName);

See also

Go back to Packages List