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

一个多年前的压缩解压缩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;
begin
end.

        
        



        







        
          
            
            评论这张
          
        


          
            
              
            
            转发至微博