使用 Delphi 创建压缩（Zipped）文件夹

Question

我可以使用 Delphi 创建 Windows XP 的 Compressed (Zipped) 文件夹吗？

Answer 1

如果您使用的是 Delphi X2，只需使用 System.Zip 中的 TZipFile：

要压缩文件夹，请使用：

TZipFile.ZipDirectoryContents('ZipFile.zip', 'C:\Zip\this\right\now');

要压缩文件，请使用：

Zip := TZipFile.Create;
try
  Zip.Open('ZipFile.zip', zmWrite);

  Zip.Add('FileToBeZipped.txt');
  Zip.Add('ThisWillBeCompressedAgainForSureAndBecomeSmaller.zip');
finally
  Zip.Free;
end

Answer 2

根据eggheadcafe中的一个帖子，您可以使用CreateFile Function和FILE_FLAG_BACKUP_SEMANTICS创建一个压缩文件夹。

关于shell扩展路由，请看Using Windows XP "Compressed Folder" shell extension to work with .zip files的Namespace Edanmo，它是用VB编写的。

我刚刚发现在 C++ 上提出的类似问题。看看Creating a ZIP file on Windows (XP/2003) in C/C++。我觉得最简单的方法是购买 ZipForge。见Zip a file in Delphi code sample。

Answer 3

前段时间，我尝试了所有能找到的 Delphi 压缩库，最终我最终使用了 KaZip by Kiril Antonov。

我的要求是：

• 免费；
• 开源；
• 本机 Delphi 代码；
• 没有外部依赖项（dll、exe）。我最重要的要求；
• 内存占用小；
• 易于使用；

我主要使用它来将 .kml 文件转换为 .kmz，而且速度非常快。

以下是我如何使用它的示例：

uses
  KaZip;

...

// replaces a .kml file with a .kmz file
procedure KmlToKmz(const aFileName: string);
var
  FS: TFileStream;
  KaZip:TKaZip;
  KmzFileName:TFileName;
begin
  KmzFileName := ChangeFileExt(aFileName, '.kmz');
  KaZip := TKaZip.Create(nil);
  try
    // create an empty zipfile with .kmz extension:
    FS := TFileStream.Create(KmzFileName, fmOpenReadWrite or FmCreate);
    try
      KaZip.CreateZip(FS);
    finally
      FS.Free;
    end;        

    KaZip.Open(KmzFileName); // Open the new .kmz zipfile
    KaZip.Entries.AddFile(aFileName); // add the .kml
    KaZip.Close; 
    DeleteFile(aFileName); // delete the .kml
  finally
    KaZip.Free;
  end;
end;

Answer 4

看看这个OpenSource SynZip unit。它的解压速度甚至比 Delphi 自带的默认单元更快，而且会生成更小的 exe（crc 表在启动时创建）。

不需要外部 dll。适用于从 Delphi 6 到 XE。 Delphi 的 Unicode 版本没有问题。全部在一个单元中。

我刚刚做了一些更改来处理 Zip 内容中的 Unicode 文件名，不仅是 Win-Ansi 字符集，还有任何 Unicode 字符。欢迎反馈。

Answer 5

你可以使用TurboPower Abbrevia，它现在是开源的。

Answer 6

Windows 中的“压缩”文件夹只不过是使用任何标准 zip 库压缩的 .ZIP 文件。压缩文件夹是另一种动物，需要 NTFS 磁盘格式。

对于“Zip”文件，我强烈建议使用Turbo Power Abbrevia，它是开源的并且运行良好。如果您使用的是 Delphi 2009，您可能需要查看此 alternate 站点，因为它可能是更新的副本。

如果您想使用压缩文件夹选项，您需要修改目录句柄上的目录标志。这只会影响添加到该目录的新文件，不会自动压缩现有文件。如果您有一个要压缩的现有目录，则重命名每个现有文件，然后将其加载并保存回原始名称，并在每个文件完成后删除原始文件。 Yozey 有一个很好的链接到MSDN 文档。请记住，这仅适用于 NTFS 格式的磁盘，因此您需要在代码中添加一个检查。

Answer 7

您可以使用任何压缩器的某些命令行版本，例如 7zip，并使用 ShellExecute 执行任务，或者您可以使用免费或商业组件，例如 these 中的任何人。

我使用过ZipMaster，它的表现非常适合我的目的。我不知道您对尺寸、空间和性能有什么要求。

Answer 8

看看这些：

• File Compression
• FSCTL_SET_COMPRESSION

Answer 9

TZipFile.ZipDirectoryContents 方法对我不起作用，因此我使用 TZipFile.add() 创建了自己的实现。如果有人需要，我会在这里发布。

procedure CreateZipOfDirectory(directory: string);
var
  zip: TZipFile;
  Arr: tarray<string>;
  str: string;
  
  function GetAllFilesInDir(const Dir: string): tarray<string>;
  var
    Search: TSearchRec;
    procedure addAll(arr: tarray<string>; parent: string);
    var
      tmp: string;
    begin
      for tmp in arr do
      begin
        setlength(result, length(result) + 1);
        result[length(result) - 1] := IncludeTrailingBackslash(parent) + tmp;
      end;
    end;
  begin
    setlength(result, 0);
    if FindFirst(IncludeTrailingBackslash(Dir) + '*.*', faAnyFile or faDirectory, Search) = 0 then
      try
        repeat
          if (Search.Attr and faDirectory) = 0 then
          begin
            setlength(result, length(result) + 1);
            result[length(result) - 1] := Search.Name;
          end
          else if (Search.Name <> '..') and (Search.Name <> '.') then
            addAll(GetAllFilesInDir(IncludeTrailingBackslash(Dir) + Search.Name), Search.Name);
        until FindNext(Search) <> 0;
      finally
        FindClose(Search);
      end;
  end;

begin
  Zip := TZipFile.Create;
  try
    Zip.Open('Foo.zip', zmWrite);
    arr := GetAllFilesInDir(directory); // The Delphi TZipFile.ZipDirectoryContents does not work properly, so let's create our own.
    for str in arr do
      zip.Add(directory + str, str); // Add the second parameter to make sure that the file structure is preserved.
  finally
    zip.Free;
  end;
end;