• 学习笔记:7z在delphi的应用


    最近做个发邮件的功能,需要将日志文件通过邮件发送回来用于分析,但是日志文件可能会超级大,测算下来一天可能会有800M的大小。所以压缩是不可避免了,delphi中的默认压缩算法整了半天不太好使,就看了看7z,在windows下有dll那么就用它吧。

    下载7z.dll,还有一个delphi的开发sdk文件,sevenzip.pas。有这两个就可以了。

    压缩

    使用超级简单

    procedure TForm1.Button1Click(Sender: TObject);
    var
      Arch: I7zOutArchive;
      Counter: Integer;
      sZipFile: string;
    begin
      OpenDialog1.Filter := '所有文件|*.*';
      OpenDialog1.Options := OpenDialog1.Options + [ofAllowMultiSelect];
      if OpenDialog1.Execute then
      begin
        Memo1.Lines.Append('开始压缩');
        Arch := CreateOutArchive(CLSID_CFormat7z);
        Arch.SetProgressCallback(nil, ProgressCallback);
        for Counter := 0 to OpenDialog1.Files.Count - 1 do
          Arch.AddFile(OpenDialog1.Files[Counter], ExtractFileName(OpenDialog1.Files[Counter]));
    
        SetCompressionLevel(Arch, 5);
        SevenZipSetCompressionMethod(Arch, m7LZMA);//算法设置,很重要哦
        sZipFile := FRootPath+'test.7z';
        Arch.SaveToFile(sZipFile);
        Memo1.Lines.Append('完成压缩,文件生成于:' + sZipFile);
        CalcZipScale(sZipFile, ProgressBar1.Max);    
      end;
    end;

    此方法通过文件选择框可以压缩多个文件成一个压缩包。这里有点要注意的是使用:m7LZMA这个算法压缩比特别高,好像针对文本类型的会很好。我试了400M的文本压缩后5M左右吧。这个压缩率还是挺可观的。

    另外有个需求是用于压缩整个目录的,方法也很简单:

    procedure TForm1.Button3Click(Sender: TObject);
    var
      Arch: I7zOutArchive;
      Counter: Integer;
      sZipFile: string;
    begin
      if not DirectoryExists(edtPath.Text) then
      begin
        ShowMessage('请输入有效目录');
        edtPath.SetFocus;
      end;
    
      Memo1.Lines.Add('开始压缩');
      Arch := CreateOutArchive(CLSID_CFormat7z);
      Arch.SetProgressCallback(nil, ProgressCallback);
      Arch.AddFiles(edtPath.Text, 'memData', '*.*', False);
    
      SetCompressionLevel(Arch, 5);
      SevenZipSetCompressionMethod(Arch, m7LZMA);//算法设置,很重要哦
      sZipFile := FRootPath+'path.7z';
      Arch.SaveToFile(sZipFile);
      Memo1.Lines.Append('完成压缩,文件生成于:' + sZipFile);
      CalcZipScale(sZipFile, ProgressBar1.Max);
    end;

    没什么大的区别,就是调用压缩方法时使用AddFiles,这个方法的参数要注意一下:

    procedure AddFiles(const Dir, Path, Wildcard: string; recurse: boolean); stdcall;

    Dir:待压缩的目录

    Path:压缩包中的目录(就是压缩后在压缩包里的根目录)

    Wildcard:通配符,可以用于过滤文件(*.*)

    recurse:递归子目录

    其他的压缩我就没去试了,生成7z的包用winrar反正是可以打开和解压的。

    解压

    7z也提供了解压的算法,但是不同的压缩算法生成的压缩包格式是不同的,需要指定解压类型来解压。但我看7z里支持的算法类型还是很全的,于是就整了个If列表。

    先看看解压的方法:

    procedure TForm1.Button2Click(Sender: TObject);
    var
      Arch: I7zInArchive;
      Counter: Integer;
      sExtractPath: string;
    begin
      OpenDialog1.Filter := '压缩文件|*.zip;*.rar;*.7z';
      OpenDialog1.Options := OpenDialog1.Options - [ofAllowMultiSelect];
      if OpenDialog1.Execute then
      begin
        Memo1.Lines.Append('开始解压');
        try
          Arch := GetInArchiveByFileExt(ExtractFileExt(OpenDialog1.FileName));
          Arch.SetProgressCallback(nil, ProgressCallback);
          Arch.OpenFile(OpenDialog1.FileName);
          for Counter := 0 to Arch.NumberOfItems - 1 do
          begin
            if not Arch.ItemIsFolder[Counter] then
              Memo1.Lines.Append('包含文件:' + Arch.ItemPath[Counter]);
          end;
    
          sExtractPath := FRootPath + getShotFileName(ExtractFileName(OpenDialog1.FileName));
          if ForceDirectories(sExtractPath) then
          begin
            Arch.ExtractTo(sExtractPath);
            Memo1.Lines.Append('完成解压');
          end
          else
            ShowMessage('无法解压到指定目录');
        except
          on e: Exception do
            Memo1.Lines.Add('发生异常:' + e.Message)
        end;
    
        Arch := nil;
        Memo1.Lines.Add('-----------------------------------------------------------');
      end;
    end;

    解压时是调用ExtractTo来解压的,简单。只不过要通过后缀来选择特定的解压对象需要单独处理一下,写了个方法:

    function TForm1.GetInArchiveByFileExt(AExt: string): I7zInArchive;
    var
      sExt: string;
    begin
      sExt := UpperCase(AExt);
      if (sExt='.ZIP') or (sExt='.JAR') or (sExt='.XPI') then
        Result := CreateInArchive(CLSID_CFormatZip)
      else if (sExt='.BZ2') or (sExt='.BZIP2') or (sExt='.TBZ2') or (sExt='.TBZ') then
        Result := CreateInArchive(CLSID_CFormatBZ2)
      else if (sExt='.RAR') or (sExt='.R00') then
        Result := CreateInArchive(CLSID_CFormatRar)
      else if (sExt='.ARJ') then
        Result := CreateInArchive(CLSID_CFormatArj)
      else if (sExt='.Z') or (sExt='.TAZ') then
        Result := CreateInArchive(CLSID_CFormatZ)
      else if (sExt='.LZH') or (sExt='.LHA') then
        Result := CreateInArchive(CLSID_CFormatLzh)
      else if (sExt='.7Z') then
        Result := CreateInArchive(CLSID_CFormat7z)
      else if (sExt='.CAB') then
        Result := CreateInArchive(CLSID_CFormatCab)
      else if (sExt='.NSIS') then
        Result := CreateInArchive(CLSID_CFormatNsis)
      else if (sExt='.LZMA') then
        Result := CreateInArchive(CLSID_CFormatLzma)
      else if (sExt='.LZMA86') then
        Result := CreateInArchive(CLSID_CFormatLzma86)
      else if (sExt='.EXE') then
        Result := CreateInArchive(CLSID_CFormatPe)
      else if (sExt='.PE') or (sExt='.DLL') or (sExt='.SYS') then
        Result := CreateInArchive(CLSID_CFormatPe)
      else if (sExt='.ELF') then
        Result := CreateInArchive(CLSID_CFormatElf)
      else if (sExt='.MACHO') then
        Result := CreateInArchive(CLSID_CFormatMacho)
      else if (sExt='.UDF') then
        Result := CreateInArchive(CLSID_CFormatUdf)
      else if (sExt='.XAR') then
        Result := CreateInArchive(CLSID_CFormatXar)
      else if (sExt='.MUB') then
        Result := CreateInArchive(CLSID_CFormatMub)
      else if (sExt='.HFS') or (sExt='.CD') then
        Result := CreateInArchive(CLSID_CFormatHfs)
      else if (sExt='.DMG') then
        Result := CreateInArchive(CLSID_CFormatDmg)
      else if (sExt='.MSI') or (sExt='.DOC') or (sExt='.XLS') or (sExt='.PPT') then
        Result := CreateInArchive(CLSID_CFormatCompound)
      else if (sExt='.WIM') or (sExt='.SWM') then
        Result := CreateInArchive(CLSID_CFormatWim)
      else if (sExt='.ISO') then
        Result := CreateInArchive(CLSID_CFormatIso)
      else if (sExt='.BKF') then
        Result := CreateInArchive(CLSID_CFormatBkf)
      else if (sExt='.CHM') or (sExt='.CHI') or (sExt='.CHQ') or (sExt='.CHW')
              or (sExt='.HXS') or (sExt='.HXI') or (sExt='.HXR') or (sExt='.HXQ')
              or (sExt='.HXW') or (sExt='.LIT') then
        Result := CreateInArchive(CLSID_CFormatChm)
      else if  (sExt='.001') then
        Result := CreateInArchive(CLSID_CFormatSplit)
      else if  (sExt='.RPM') then
        Result := CreateInArchive(CLSID_CFormatRpm)
      else if  (sExt='.DEB') then
        Result := CreateInArchive(CLSID_CFormatDeb)
      else if  (sExt='.CPIO') then
        Result := CreateInArchive(CLSID_CFormatCpio)
      else if  (sExt='.TAR') then
        Result := CreateInArchive(CLSID_CFormatTar)
      else if  (sExt='.GZ') or (sExt='.GZIP') or (sExt='.TGZ') or (sExt='.TPZ') then
        Result := CreateInArchive(CLSID_CFormatGZip)
      else
        Result := CreateInArchive(CLSID_CFormatZip);
    end;

    没想到7z的完成度这么高,还是非常方便的。

    后记:以前在.net平台上调用过7z,只不过是使用shell方式调用的7z.exe。用命令感觉会麻烦一些,使用dll集成在程序中还是挺方便的。

  • 相关阅读:
    多语言资源文件制作工具
    window service 插件服务插件开发
    .net 中读取自定义Config文件
    Asp.net 主题中CSS文件的缓存问题
    Asp .net 4.0 中ViewStatus 使用
    Linq通用分页数据查询方法
    EF中查询出现死锁的处理
    Windows Live Writer 分享到插件
    Windows Resx资源文件编辑工具
    插件式服务架构
  • 原文地址:https://www.cnblogs.com/5207/p/5105949.html
Copyright © 2020-2023  润新知