数据压缩 -- 应用[1]

[入库:2005年8月18日] [更新:2007年3月24日]

本文简介:选择自 luckyjan 的 blog

例:多个目录下多个文件压缩到一个文件;
    对压缩文件解压到个对应目录。
   //压缩文件流: 文件名长度 + 文件名 + 文件长度 + 压缩流
  
uses lh5unit.pas;   //见  数据压缩 -- 源码

procedure compress;
var
  foutstr: tfilestream;                                  //压缩文件流 

  function doonefile(srcfile:string):boolean;            //把一个文件压缩到 压缩文件流
  var finstr: tfilestream;
      ftmp:tmemorystream;
      fnlen,sz:integer;
  begin
    result:=true;
    if not fileexists(srcfile) then exit;
    try
      finstr := tfilestream.create(srcfile,fmopenread);
      ftmp   := tmemorystream.create;
      try
        //在目标流 插入文件名长度 ,文件名,文件长度
        fnlen :=length(srcfile);
        foutstr.write(fnlen,sizeof(integer));      //文件名长度       // 或 sizeof(i)
        foutstr.write(pfilename[1],fnlen);         //文件名
        lhacompress(finstr, ftmp);                 //压缩文件 到 tmemorystream
        sz:=ftmp.size ;
        foutstr.write(sz,sizeof(integer));         //文件压缩长度
        foutstr.write(ftmp.memory^,sz);             //压缩流
      finally
        finstr.free;
        ftmp.free;
      end;
    except
      result:=false;
    end;
  end;

var
  lhfile,afilename:string;
begin
  result:=true;
  try
    lhfile:=extractfilepath(application.exename)+'filepack.lhz';  //压缩文件名
    if fileexists(lhfile) then deletefile(lhfile);

    foutstr := tfilestream.create(lhfile,fmcreate);
    try
        .....  //检索要压缩的文件列表
        opensql('select htmfile from faq where flags=1 order by htmfile',data.tblhz);

        while not data.tblhz.eof do
        begin
          afilename:='faqfile\'+data.tblhz.fieldbyname('htmfile').asstring+'.html';
          if not doonefile(extractfilepath(application.exename)+afilename,afilename) then
          begin
            result:=false;  //压缩不成功
            break;
          end;
          data.tblhz.next;
        end;     
    finally
      foutstr.free;
    end;
  except
    result:=false;  //压缩不成功
  end;
end;

function expand(lhfile:string): boolean;
var
  src_f:tfilestream;

  function getonefile(afilelen:integer;tfilename:string):boolean;
  var
      dst_f:tfilestream;
      mem_f:tmemorystream;
  begin
    result:=true;
    try 
      if fileexists(tfilename) then deletefile(afile); //已存在,覆盖它

      dst_f := tfilestream.create(afile,fmcreate or fmopenwrite);
      mem_f := tmemorystream.create;
      try

本文关键:数据压缩 -- 应用
  相关方案
Google
 

本站最佳浏览方式为 分辨率 1024x768 IE 6.0(或更高版本的 IE浏览器)

go top