VclZip 3.10.1的简单使用示例

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

001 002 003 004 005 006 007 008 009 010 011 012 013 014 015 016 017 018 019 020 021 022 023 024 025 026 027 028 029 030 031 032 033 034 035 036 037 038 039 040 041 042 043 044 045 046 047 048 049 050 051 052 053 054 055 056 057 058 059 060 061 062 063 064 065 066 067 068 069 070 071 072 073 074 075 076 077 078 079 080 081 082 083 084 085 086 087 088 089 090 091 092 093 094 095 096 097 098 099 100 101 102 103 104 105 106 107 108 109 110 111

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.

运行结果如下图所示：