vclzip不能压缩索引-求解

2013-01-01

vclzip不能压缩目录-求解在网上找了段代码用,vclzip来压缩的.可是不能压缩目录中的的子目录,只压了目录中

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

vclzip不能压缩索引-求解