VclZip 3.10.1的简单使用示例

一款VCL控件，可以用来压缩或解压缩ZIP格式文件，支持ZIP64格式。
示例代码：

unit Unit1;  
  
interface  
  
uses  
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
  Dialogs, StdCtrls, VCLZip, VCLUnZip;  
  
type  
  TForm1 = class(TForm)  
    btn_Zip: TButton;  
    lst1: TListBox;  
    btn_UnZip: TButton;  
    edt1: TEdit;  
    procedure btn_ZipClick(Sender: TObject);  
    procedure btn_UnZipClick(Sender: TObject);  
  private  
    { Private declarations }  
  public  
    { Public declarations }  
  end;  
  
var  
  Form1: TForm1;  
  
implementation  
  
{$R *.dfm}  
  
{-------------------------------------------------------------------------------  
  过程名:    DoZip  
  功能:      压缩          
  参数:      sDir,             要压缩的根目录  
             sFile: string;    压缩后的文件名  
             slList: TStrings  要压缩的文件列表  
  返回值:    Boolean           压缩是否成功  
-------------------------------------------------------------------------------}  
function DoZip(sDir,sFile: string;slList: TStrings):Boolean;  
var  
  vzip: TVCLZip;  
begin  
  Result := True;  
  vzip := TVCLZip.Create(nil);  
  try  
    with vzip do  
    begin  
      ZipName := sFile;    //压缩后文件名  
      RootDir := sDir;     //根目录，不存储这个目录文件夹  
      FilesList := slList; //压缩文件列表，支持通配符*.*  
      AddDirEntriesOnRecurse := True; //空目录也添加  
      RelativePaths := True;          //相对路径  
      try  
        Zip;  
      except  
        Result := False;  
      end;    
    end;  
  finally  
    FreeAndNil(vzip);  
  end;     
end;  
  
{-------------------------------------------------------------------------------  
  过程名:    DoUnZip  
  功能:      解压缩          
  参数:      sDir,         要释放压缩文件的目录  
             sFile: string 要解压缩的文件名  
  返回值:    Boolean       解压缩是否成功  
-------------------------------------------------------------------------------}  
function DoUnZip(sDir,sFile: string):Boolean;  
var  
  vunzip: TVCLUnZip;  
begin  
  Result := True;  
  vunzip := TVCLUnZip.Create(nil);  
  try  
    with vunzip do  
    begin  
      ZipName := sFile;     //欲解压的文件  
      ReadZip;              //读取压缩包信息  
      FilesList.Add('*.*'); //通配符，添加所有文件  
      DestDir := sDir;      //解压目的地路径  
      RecreateDirs := True; //创建目录结构  
      try  
        UnZip;  
      except  
        Result := False;  
      end;  
    end;  
  finally  
    FreeAndNil(vunzip);  
  end;     
end;  
  
procedure TForm1.btn_ZipClick(Sender: TObject);  
begin  
  if DoZip('E:/CVSS/','F:/test1.zip',lst1.Items) = True then  
    ShowMessage('压缩成功')  
  else  
    ShowMessage('压缩失败');  
end;  
  
procedure TForm1.btn_UnZipClick(Sender: TObject);  
begin  
  if DoUnZip('F:/abc/',edt1.Text) = True then  
    ShowMessage('解压缩成功')  
  else  
    ShowMessage('解压缩失败');  
end;  
  
end.