一款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. |
运行结果如下图所示：
