Delphi 的TZipFile压缩文件自定义（去掉盘符）

关于Delphi中的TZipFile压缩文件，非常方便，该类位于System.Zip单元中，压缩一个目录只需要一条命令TZipFile.ZipDirectoryContents就可以，但是这也有个不方便，就是不能动态增加文件和目录。如果想自定义增加文件或者目录，而且正常显示所增加的目录标志，就需要使用TZipFile.add函数了。

本文使用盒子论坛 v2.1 (2ccc.com)上的讨论，把通过TZipFile.add增加文件或者目录可能会把磁盘符号也增加上，这不是大家期望的，下面程序演示了如何去掉磁盘符号及多余的目录级别。

事实上，Delphi的帮助文档有说明，只是说的不是很清楚，主要没有举例说明，所以大家使用起来不顺手，好像不能满足要求一样，事实不是这样的。

源代码如下：

需要注意MY_PATH_TO_ZIP路径有没有最后一个'\'是有区别的，反映到下面的源代码，请看77行，如果最后面有这个'\'，则77行目前是正确的，如果没有，则77行中的长度需要+1。

总之，就是理解 ArchiveFileName 这个参数如何使用就可以实现自定义增加Zip文件了！

unit uView.MainForm;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    BtnGetFilesOnDirectory: TButton;
    BtnPrepareZIP: TButton;
    Memo1: TMemo;
    procedure BtnGetFilesOnDirectoryClick(Sender: TObject);
    procedure BtnPrepareZIPClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  System.IOUtils,
  System.Zip;

const
  MY_PATH_TO_ZIP: string = 'C:\Users\AAA\';
  MY_ZIP_TARGET: string  = 'C:\Users\AutoBuild\exmail45.zip';

procedure TForm1.BtnGetFilesOnDirectoryClick(Sender: TObject);
begin
  ListBox1.Items.AddStrings(TDirectory.GetFiles(MY_PATH_TO_ZIP, '*.*', TSearchOption.soAllDirectories));
end;

procedure TForm1.BtnPrepareZIPClick(Sender: TObject);
var
  MyZIP: TZipFile;
  LRemoveTextInit : string;
begin
  if (ListBox1.Items.Count = 0) then
    begin
      ShowMessage('none files to zip... verify your ListBox content');
      //
      exit;
    end;
  //
  if FileExists(MY_ZIP_TARGET) then
    DeleteFile(MY_ZIP_TARGET);
  //
  MyZIP := TZipFile.Create;
  try
    try
      MyZIP.Open(MY_ZIP_TARGET, TZipMode.zmWrite);
      //
      for var F in ListBox1.Items do
        begin
          Memo1.Lines.Add(F);
          //MyZIP.Add(F, ExtractFilePath(F) + ExtractFileName(F), TZipCompression.zcDeflate);

          if F.Contains(MY_PATH_TO_ZIP) then // removing "D:\D:\TestMyDataBase"
          LRemoveTextInit := ExtractFilePath(F).Remove(0, MY_PATH_TO_ZIP.Length) + ExtractFileName(F);
          //
          MyZIP.Add(F, LRemoveTextInit, TZipCompression.zcDeflate);
        end;
      //
      Memo1.Lines.Add('---------');
      Memo1.Lines.AddStrings(MyZIP.FileNames);
      //
      MyZIP.Close;
    except
      on E: Exception do
        ShowMessage('ZIP error: ' + slinebreak + E.Message);
    end;
  finally
    MyZIP.Free;
  end;
end;

end.

谨此记录下来，方便大家使用！感谢mailx45 (emailx45)！