FreePascal - 用Abbrevia压缩和解压缩目录和文件!!

开发工具:Typhon32

Abbrevia版本:6.9.1

Abbrevia对于Delphi程序员来说,无须多言,是大名鼎鼎的压缩和解压缩控件,下面是它的介绍:

http://tpabbrevia.sourceforge.net/

我写了两个函数,分别对应压缩和解压缩:

A,压缩:

     1,压缩目录:可以压缩多级目录。

     2,压缩文件:将指定的文件压缩。

B,解压缩:

    1,解压缩目录:对压缩文件是目录的压缩文件,解压缩到指定的目录中,并且将保持压缩前的目录结构。

    2,解压缩文件:对压缩文件就是单个文件的压缩文件,解压缩到指定的文件。

下面是完整,经过认真测试的代码:

uses  
  {压缩控件用单元}
  AbBrowse, AbZBrows, AbZipper, AbUnzper,
  AbArcTyp//它是TAbZipper各种属性的单元文件
  ;
{
  压缩目录或指定的文件
  参数:
  Password:压缩用密码
  inputParam:要压缩目录名称或文件名
  zipFileName:生成的压缩文件名称
  isZipDir:是否压缩目录(true:目录;false:文件)
}
function AbZip(zipPassword, inputParam, zipFileName: string; isZipDir: boolean = False): boolean;
var
  isSuccess: boolean;  //是否压缩成功的布尔值
  AbZipper1: TAbZipper;//压缩对象
begin

  isSuccess := True; // 是否压缩成功默认值为true

  try

    // 创建压缩对象
    AbZipper1 := TAbZipper.Create(nil);

    try
      with AbZipper1 do
      begin

        Password := ansistring(trim(zipPassword)); // 设置压缩密码

        //压缩目录
        if isZipDir = True then
        begin
          StoreOptions := [soRecurse]; //注意:soRecurse决定压缩子目录,不要添加其它属性了!!
          BaseDirectory := trim(inputParam); // 设置压缩文件所在目录
          FileName := trim(zipFileName); // 设置要生成的压缩文件名
          AddFiles('*.*', 0); // 压缩全部文件
        end
        else //压缩单个文件
        begin
          BaseDirectory := ExtractFilePath(inputParam); // 设置压缩文件所在目录(从当前要压缩文件中抽取)
          FileName := trim(zipFileName); // 设置要生成的压缩文件名
          AddFiles(ExtractFileName(inputParam), 0); // 压缩指定的文件(从当前要压缩文件中抽取)
        end;

        CloseArchive;
      end;
    except
      on e: Exception do
      begin
        isSuccess := False;
      end;
    end;
  finally
    AbZipper1.Free; //释放创建的对象
  end;

  Result := isSuccess;
end;

{
  解压缩文件到指定的目录或指定的文件
  参数:
  Password:解压缩用密码
  inputParam:存放解压缩文件的目录或解压缩后的文件名
  zipFileName:要解压缩的文件名称
  isUnZipToDir:是否解压缩文件到目录(true:解压缩到目录;false:解压缩到指定的文件)
}
function AbUnZip(zipPassword, inputParam, zipFileName: string; isUnZipToDir: boolean = False): boolean;
var
  isSuccess: boolean; // 是否解压缩成功的布尔值
  AbUnZipper1: TAbUnZipper;//解压缩对象
begin

  isSuccess := True; // 是否解压缩成功的布尔值默认值为true

  try

    // 创建解压缩控件
    AbUnZipper1 := TAbUnZipper.Create(nil);

    try

      // 把指定目录压缩成文件
      with AbUnZipper1 do
      begin
        Password := ansistring(trim(zipPassword)); // 设置解压缩密码

        //解压缩到目录
        if isUnZipToDir = True then
        begin

          //把压缩文件中的多层目录一起解压缩成压缩前的目录结构
          ExtractOptions := [eoCreateDirs, eoRestorePath];

          //如果解压缩文件存放的目录不存在,则创建
          BaseDirectory := trim(inputParam); // 设置解压缩文件存放的目录
          if DirectoryExists(BaseDirectory) = False then
          begin
            CreateDir(BaseDirectory);
          end;

          FileName := trim(zipFileName); // 设置要被解压缩的文件名
          ExtractFiles('*.*'); // 解压缩文件
        end
        else  //解压缩到文件
        begin
          BaseDirectory := ExtractFilePath(inputParam); // 设置解压缩文件存放的目录
          //如果解压缩文件存放的目录不存在,则创建
          if DirectoryExists(BaseDirectory) = False then
          begin
            CreateDir(BaseDirectory);
          end;

          FileName := trim(zipFileName); // 设置要被解压缩的文件名
          ExtractFiles('*.*'); // 解压缩文件
        end;

        CloseArchive;
      end;
    except
      on e: Exception do
      begin
        isSuccess := False;
      end;
    end;
  finally
    AbUnZipper1.Free;  //释放解压缩对象
  end;

  Result := isSuccess;
end;                     

good lucky !!

posted on 2020-09-02 23:43  sunylat  阅读(701)  评论(0编辑  收藏  举报