\t\t一个多年前的压缩解压缩（VCLZIP）函数。

最新推荐文章于 2020-10-16 14:24:56 发布

sun280

最新推荐文章于 2020-10-16 14:24:56 发布

阅读量236

点赞数

分类专栏： delphi技术

本文链接：https://blog.csdn.net/sun280/article/details/10471035

版权

delphi技术专栏收录该内容

83 篇文章 0 订阅

订阅专栏

一个多年前的压缩解压缩DLL函数，支持ZIP类型。

控件为VCLZIP3.X，使用了FastMM4。VCLZIP是一个非常不错的压缩控件。

调用示例：

1、压缩单个文件

ZipFolder(sFilePath, '', True, ExtractFileName(sHtmlFileName), sFilePath + sZipFileName, '');

2、压缩文件夹：

ZipFolder(sFilePath, sHtmlFolderName,True, '*.*', sFilePath + sZipFileName, '');

3、解压缩

UnZipFolder(sHtmlTempPath + sFileName, sHtmlTempPath, '');

源码如下：

library ZipFunc;

uses
FastMM4,
SysUtils,
Classes,
VCLUnZip,
VCLZip;

{$R *.res}
/// <summary>
/// 压缩文件夹
/// </summary>
/// <param name="ZipFolder">文件夹目录</param>
/// <param name="RelativePath">相对路径</param>
/// <param name="IsRecurse">是否循环</param>
/// <param name="ZipFileExt">过滤文件后缀名，一般为*.*，如果只压缩单个文件，则为具体的文件名</param>
/// <param name="ZipToFileName">压缩生成的文件名</param>
/// <param name="ZipExclusionExt">不压缩文件的后缀名</param>
/// <returns></returns>
function ZipFolder(ZipFolder:string;
                     RelativePath:string;
                     IsRecurse:Boolean;
                     ZipFileExt:string;
                     ZipToFileName:string;ZipExclusionExt:string):Boolean;stdcall;
var
    sZipFileName:string;

begin
     Result := False;
     with TVCLZip.Create(nil) do
     try
       RecreateDirs := True;
       PackLevel := 9;
       StorePaths := True;
       RootDir := ZipFolder;
       RelativePathList.Add(RelativePath);
       RelativePaths := True;
       //允许多个文件扩展名
       if ZipFileExt<>'' then
       begin
         if Pos(',',ZipFileExt) > 0 then
         begin
           FilesList.Delimiter :=',';
           FilesList.DelimitedText := ZipFileExt;
         end
         else if Pos(';',ZipFileExt) > 0 then
         begin
           FilesList.Delimiter :=';';
           FilesList.DelimitedText := ZipFileExt;
         end
         else
           FilesList.Add(ZipFileExt);
       end;

       Recurse := IsRecurse;//是否循环
       if ZipExclusionExt<>'' then
       begin
         if Pos(',',ZipExclusionExt) > 0 then
         begin
           ExcludeList.Delimiter :=',';
           ExcludeList.DelimitedText := ZipExclusionExt;
         end
         else if Pos(';',ZipExclusionExt) > 0 then
         begin
           ExcludeList.Delimiter :=';';
           ExcludeList.DelimitedText := ZipExclusionExt;
         end
         else
           ExcludeList.Add(ZipExclusionExt);
       end;

       sZipFileName := ZipToFileName;

       if ExtractFileExt(sZipFileName) = '' then
         sZipFileName := ExtractFileDir(RootDir) + '.Zip';

       ZipName := sZipFileName;
       Zip;
       Result := True;
     finally
       Free;
     end;
end;

function UnZipFolder(
            ZipFileName:string;
            OutPutPath:string;
            ZipExclusionExt:string):Boolean;stdcall;
var
    sOutPutPathName:string;
begin
    Result := False;
     with TVCLUnZip.Create(nil) do
     try
       OverwriteMode := Always;
       DoAll := True;
       if OutPutPath <> '' then
         DestDir := OutPutPath
       else
         DestDir := ExtractFileDir(ExpandFileName(ZipFileName));
       //OverwriteMode := ;
       //允许多个文件扩展名
       if ZipExclusionExt<>'' then
       begin
         if Pos(',',ZipExclusionExt) > 0 then
         begin
           FilesList.Delimiter :=',';
           FilesList.DelimitedText := ZipExclusionExt;
         end
         else if Pos(';',ZipExclusionExt) > 0 then
         begin
           FilesList.Delimiter :=';';
           FilesList.DelimitedText := ZipExclusionExt;
         end
         else
           FilesList.Add(ZipExclusionExt);
       end;
       ZipName := ZipFileName;
       ReadZip;
       RecreateDirs := True;
       UnZip;
       Result := True;
     finally
       Free;
     end;
end;
exports
    ZipFolder,UnZipFolder;