Delphi VclZip用法详

【转】VCLZIP的一些用法

//==========================================

http://blog.163.com/zhangzhifeng688@126/blog/static/165262758201112235933754/

http://www.delphibbs.com/keylife/iblog_show.asp?xid=11835

Vclzip控件主要的类为TVclUnZip 和TVclZip 其中，TVclZip继承自TVclUnZip。

网上的转帖用法：

function　Zip(ZipMode,PackSize:Integer;ZipFile,UnzipDir:String):Boolean;　//压缩或解压缩文件
var　ziper:TVCLZip;
begin
//函数用法：Zip(压缩模式，压缩包大小，压缩文件，解压目录)
//ZipMode为0：压缩；为1：解压缩　PackSize为0则不分包；否则为分包的大小
try
if　copy(UnzipDir,　length(UnzipDir),　1)　=　'\'　then
UnzipDir　:=　copy(UnzipDir,　1,　length(UnzipDir)　-　1);　//去除目录后的“\”
ziper:=TVCLZip.Create(application);　//创建zipper
ziper.DoAll:=true;　//加此设置将对分包文件解压缩有效
ziper.OverwriteMode:=Always;　//总是覆盖模式
if　PackSize<>0　then　begin　//如果为0则压缩成一个文件，否则压成多文件
ziper.MultiZipInfo.MultiMode:=mmBlocks;　//设置分包模式
ziper.MultiZipInfo.SaveZipInfoOnFirstDisk:=True;　//打包信息保存在第一文件中
ziper.MultiZipInfo.FirstBlockSize:=PackSize;　//分包首文件大小
ziper.MultiZipInfo.BlockSize:=PackSize;　//其他分包文件大小
end;
ziper.FilesList.Clear;
ziper.ZipName　:=　ZipFile;　//获取压缩文件名
if　ZipMode=0　then　begin　//压缩文件处理
ziper.FilesList.Add(UnzipDir+'\*.*');　//添加解压缩文件列表
Application.ProcessMessages;　//响应WINDOWS事件
ziper.Zip;　//压缩
end　else　begin
ziper.DestDir:=　UnzipDir;　//解压缩的目标目录
ziper.UnZip;　//解压缩
end;
ziper.Free;　//释放压缩工具资源
Result:=True;　//执行成功
except
Result:=False;//执行失败
end;
end;

function AddZipFile(ZipFileName,FileName:pchar):integer;stdcall;
var
   ziper:TVclZip;
begin
   result:=0;
try
   try
    ziper:=TVclZip.Create(nil);
    ziper.OverwriteMode:=Always;//总是覆盖
    ziper.DoAll:=true;//压缩所有文件
    ziper.RelativePaths:=true;//是否保持目录结构
    ziper.AddDirEntriesOnRecurse:=true;
    ziper.RecreateDirs:=true;//创建目录
    ziper.StorePaths:=true;//保存目录信息
    //ziper.Recurse:=true;
   except
    exit;
   end;
    if FileExists(StrPas(ZipFileName)) then
    begin
      if UnZipFile(ZipFileName,TempDir)=1 then
        begin
          ziper.FilesList.Add(TempDir+StrPas(ZipFileName)+'\*.*');
          ziper.FilesList.Add(StrPas(FileName));
          ziper.ZipName:=strpas(ZipFileName);
          ziper.Zip;
          result:=1;
        end;
    end
    else
    begin
      ziper.FilesList.Add(FileName);
      ziper.ZipName:=StrPas(ZipFileName);
      ziper.zip;
      result:=1;
    end;
finally
   ziper.Free;
end;

把指定目录（带子目录）的所有文件压缩到一个目录下：

function AddDirAll(Dir,ZipFileName:pchar):integer;stdcall;
var
   Ziper:TVclZip;
   FileRec: TSearchrec;
   TempDir:String;
begin
   if FindFirst(Strpas(Dir),faAnyFile,FileRec) = 0 then
      begin
        repeat
          if (FileRec.Attr and faDirectory) <> 0 then
            begin
              TempDir:=StrPas(Dir)+'\'+FileRec.Name;
              AddDirAll(PChar(TempDir),ZipFileName);
              end;
         if (FileRec.Attr and faAnyFile )<> 0 then
            begin
              result:=AddZipFile(ZipFileName,Pchar(TempDir+'\*.*'));
              end;
          until FindNext(FileRec) <> 0 ;
        end;

end;

作者　:Yangzh
标题　: vclzip开发实例
关键字:
分类　:个人专区
密级　: 公开 (评分: , 回复: 0, 阅读: 1577) ??

vclzip开发实例
关键字:
分类　: 项目案例分析
密级　: 公开
(评分: , 回复: 0, 阅读: 54) »»
//压缩
procedure TForm1.FlatButton1Click(Sender: TObject);
var
FilePath:String;
// numberzip:Smallint;
begin
FilePath:=ExtractFilePath(Application.ExeName)+'顺德';
{ Thread1:=TShowProgress.create(FilePath); //创建线程计算总目录
Thread1.Priority:=tpNormal;
Thread1.FreeOnTerminate:=True;
}

FilePath:=ExtractFilePath(Application.ExeName)+'sd.cab';
VCLZip1.ZipName:=FilePath;

// FilePath:=ExtractFilePath(Application.ExeName)+'顺德\*.*';
FilePath:='.\顺德\*.*';
VCLZip1.FilesList.Add(FilePath);

VCLZip1.Recurse:=True;
VCLZip1.StorePaths:=True;
VCLzip1.PackLevel:=9;

// VCLZip1.Password:='944500';

try
VCLZip1.Zip;
Except
showmessage('Error!');
end;

MessageBox(0,'压缩成功','成功',MB_OK+MB_ICONINFORMATION);
end;
//解压缩 MemoPad,TMemo控件
procedure TForm1.FlatButton2Click(Sender: TObject);
var
FilePath:string;
NumUnzipped:integer;
i:integer;
begin
FilePath:=ExtractFilePath(Application.ExeName)+'sd.cab';

with VCLUnZip1 do
begin
ZipName := Filepath; // set the zip filename
ReadZip; // open it and read its information

FilesList.Add('*.*');
FilesList.Add( Filename[Count-1] ); // extract last entry in zipfile

DoAll := False; // Don't unzip all files

FilePath:='D:\王锋\Setup';
DestDir :=FilePath ; // Set destination directory
RecreateDirs := True; // don't recreate directory structures
RetainAttributes := True; // Set attributes to original after unzipping

MemoPad.Clear;
MemoPad.Lines.Add(VCLUnZip1.Filename[CountUnzip]);
NumUnzipped := Unzip; // Extract files, return value is the number of files actually unzipped
MessageBox(0,'压缩成功','成功',MB_OK+MB_ICONINFORMATION);
end;
end;

http://topic.csdn.net/u/20110310/09/8d94a04a-6563-4581-a4e6-7d6ba39ab40a.html

unit uCompressData;

interface

uses Classes, VCLUnZip, VCLZip, Windows, Forms, SysUtils;

type
TCompressData=class(Tobject)
private
    FPassWord: string;
    FVCLZip: TVCLZip;
    FOnFilePercentDone: TFilePercentDone;
    FFileName: string;
    FFileListTxt: string;
    FRootDir: string;
    FOnZipComplete: TZipComplete;
    FOnCompressError: TNotifyEvent;
    procedure SetPassWord(const Value: string);
    procedure SetOnFilePercentDone(const Value: TFilePercentDone);
    procedure SetFileName(const Value: string);
    procedure SetFileListTxt(const Value: string);
    function GetFileListTxt: string;
    procedure SetRootDir(const Value: string);
    procedure SetOnZipComplete(const Value: TZipComplete);
    procedure SetOnCompressError(const Value: TNotifyEvent);
public
    function Compress:Boolean;
    procedure AddFile(AFile: string);
    constructor Create;
    destructor Destroy; override;
    property PassWord:string read FPassWord write SetPassWord;
    property FileName:string read FFileName write SetFileName;
    property RootDir:string read FRootDir write SetRootDir;
    property FileListTxt:string read GetFileListTxt write SetFileListTxt;
    property OnCompressError:TNotifyEvent read FOnCompressError write SetOnCompressError;
    property OnFilePercentDone: TFilePercentDone read FOnFilePercentDone write SetOnFilePercentDone;
    property OnZipComplete: TZipComplete read FOnZipComplete write SetOnZipComplete;
end;

implementation

{ TLoadSaveData }

procedure TCompressData.AddFile(AFile: string);
begin
FVCLZip.FilesList.Add(AFile);
end;

constructor TCompressData.Create;
begin
FVCLZip:= TVCLZip.Create(Application);
end;

destructor TCompressData.Destroy;
begin
FVCLZip.Free;
inherited;
end;

function TCompressData.GetFileListTxt: string;
begin
Result:= FVCLZip.FilesList.Text;
end;

function TCompressData.Compress:Boolean;
begin
try
    with FVCLZip do
      begin
        ZipName:= FFileName;
        RecreateDirs:=true;
        StorePaths:=True;
        Password := FPassWord;
        Recurse := True;
        RelativePaths := True;
        RootDir:=FRootDir;
        Zip;
      end;
    Result:=True;
except
    Result:=False;
    if Assigned(FOnCompressError) then
      FOnCompressError(Self);
    exit;
end;
end;

procedure TCompressData.SetFileListTxt(const Value: string);
begin
FFileListTxt := Value;
FVCLZip.FilesList.Text:= FFileListTxt;
end;

procedure TCompressData.SetFileName(const Value: string);
begin
FFileName := Value;
end;

procedure TCompressData.SetOnCompressError(const Value: TNotifyEvent);
begin
FOnCompressError := Value;
end;

procedure TCompressData.SetOnFilePercentDone(const Value: TFilePercentDone);
begin
FOnFilePercentDone := Value;
FVCLZip.OnFilePercentDone := FOnFilePercentDone;
end;

procedure TCompressData.SetOnZipComplete(const Value: TZipComplete);
begin
FOnZipComplete := Value;
FVCLZip.OnZipComplete:= FOnZipComplete;
end;

procedure TCompressData.SetPassWord(const Value: string);
begin
FPassWord := Value;
end;

procedure TCompressData.SetRootDir(const Value: string);
begin
FRootDir := Value;
end;

end.

unit uVclZipPublic;

interface

uses SysUtils, Variants, Classes,VCLZip,VCLUnZip;

function ZipFiles(zipControl:TVCLZip;Files:TStrings;MyZipName:string):Boolean;
function UnZipFiles(zipControl:TVCLZip;MyZipName,MyDestDir:string):Boolean;
function ZipDir(zipMode{0-连同根目录一起压缩，1-压缩指定目录中的所有文件和文件夹}:Integer;zipControl:TVCLZip;MyZipName,MyZipDir:string):Boolean;

implementation

function ZipFiles(ZipControl:TVCLZip;Files:TStrings;MyZipName:string):Boolean;
begin
Result:=False;
try
with ZipControl do
begin
FilesList.Text:=Files.Text;
ZipName:=MyZipName;
Zip;
Result:=True;
end;
except
//Showmessage('');
end;
end;

function UnZipFiles(zipControl:TVCLZip;MyZipName,MyDestDir:string):Boolean;
begin
Result:=False;
try
with zipControl do
begin
ZipName:=MyZipName;
ReadZip;
DestDir:=MyDestDir;
OverwriteMode:=Always;
RelativePaths:=True;
RecreateDirs:=True;
DoAll:=True;

FilesList.Add('*.*');
UnZip;
Result:=True;
end;
except

end;
end;

function ZipDir(zipMode{0-连同目录一起压缩，1-压缩指定目录中的所有文件和文件夹}:Integer;zipControl:TVCLZip;MyZipName,MyZipDir:string):Boolean;
begin
{压缩指定目录中的所有文件和文件夹，指定RootDir，否则连同指定目录本身一同压缩}
Result:=False;
try
with zipControl do
begin
case zipMode of
0:RootDir:='';
1:RootDir:=MyZipDir;
end;
OverwriteMode:=Always;
AddDirEntriesOnRecurse:=True;
RelativePaths:=True;
//Recurse:=True;
//RecreateDirs:=True;
//StorePaths:=True;
ZipName:=MyZipName;
FilesList.Add(MyZipDir+'\*.*');
Zip;
Result:=True;
end;
except

end;
end;

end.

uses VCLUnZip, VCLZip;

function ComPressFile(dstFile,srcFile:string):Boolean;
var
vclzip:TVCLZip;
begin
Result:=False;
vclzip:=TVCLZip.create(nil);
try
with vclzip do
begin
try
ZipName:=dstFile;
RecreateDirs:=true; //注意这里
StorePaths:=False;
FilesList.Add(srcFile);
Recurse := True;
Zip;
Result:=True;
except
Application.MessageBox('压缩文件失败','错误',MB_OK+MB_ICONINFORMATION);
Result:=False;
exit;
end;
end;
finally
vclzip.Free;
end;
end;

function UnComPressFile(sFile,sOutFile:string):Boolean;
var
vcluzip:TVCLUnZip;
begin
Result:=False;
vcluzip:=TVCLUnZip.Create(nil);
try
with vcluzip do
begin
try
ZipName:=sFile;
ReadZip;
FilesList.Add('*.*');
DoAll := False;
DestDir := sOutFile;
RecreateDirs := False;
RetainAttributes := True;
Unzip;
Result:=True;
except
Application.MessageBox('解压文件失败','错误',MB_OK+MB_ICONINFORMATION);
Result:=False;
exit;
end;
end;
finally
vcluzip.Free;
end;
end;

本站仅提供存储服务，所有内容均由用户发布，如发现有害或侵权内容，请点击举报。