打开APP
userphoto
未登录

开通VIP,畅享免费电子书等14项超值服

开通VIP
vclzip不能压缩目录
贴个自己写的共用单元给你,已经测过的
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.
本站仅提供存储服务,所有内容均由用户发布,如发现有害或侵权内容,请点击举报
打开APP,阅读全文并永久保存 查看更多类似文章
猜你喜欢
类似文章
【热】打开小程序,算一算2024你的财运
vclzip压缩
Delphi VclZip用法详
vclzip AddDirEntriesOnRecurse属性
vclZip控件的使用
boolean b = true?false:true == true?false:true;
mysql中boolean类型
更多类似文章 >>
生活服务
热点新闻
分享 收藏 导长图 关注 下载文章
绑定账号成功
后续可登录账号畅享VIP特权!
如果VIP功能使用有故障,
可点击这里联系客服!

联系客服