读书人

vclzip不能压缩索引-求解

发布时间: 2013-01-01 14:04:19 作者: rapoo

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.

读书人网 >.NET

热点推荐