vclzip不能压缩目录-求解
在网上找了段代码用,vclzip来压缩的.可是不能压缩目录中的的子目录,只压了目录中的文件
调用时只能是:ComPressFile('E:\test\*.*',E:\bak\20110309.zip);
必须带*.*,不能只指定目录'E:\test\'或者'E:\test'
求解,怎么样才能压缩目录中的子录目,或是指定一个目录压缩
function TForm1.ComPressFile(srcFile, dstFile: 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
Result := False;
exit;
end;
end;
finally
VCLZip.Free;
end;
end;
[解决办法]
可以的 试下这段代码:
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.