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 !!