数据压缩 -- 应用

例：多个目录下多个文件压缩到一个文件；
    对压缩文件解压到个对应目录。
   //压缩文件流: 文件名长度 + 文件名 + 文件长度 + 压缩流
  
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
        if Mem_f.CopyFrom(src_f,aFileLen)<>aFileLen then raiselastWin32Error; //获取压缩流
        Mem_f.position := 0;

        LHAExpand(Mem_f,dst_f);                    //解压

      finally
        dst_f.free;
        Mem_f.free;
      end;
    except
      result:=false;
    end;
  end;

var
   aFileName:string;
   fnlen,fSize:integer;
begin
  if not fileExists(lhFile) then exit; //压缩文件不存在!  filePack.LHZ

  result:=true;
  try
  src_f := TFileStream.Create(lhFile,fmOpenRead);
  //从临时文件中分离出所有文件的实体
  //src_f 源文件流:  文件名长度 + 文件名 + 文件压缩长度 + 压缩流(被压文件)
  try
    src_f.position := 0;
    while true do begin
      if src_f.size <=src_f.position+1 then break;           //(2.0)如果 iRtn<=0 则文件流读取结束
                                                 
      if src_f.Read(fnlen,sizeof(integer))<=0 then break;    //(2.1)取得文件名长度
      setLength(aFileName,fnlen);                
      if src_f.Read(aFileName[1],fnlen)<=0 then break;       //(2.2)取得文件名
                                                 
      if src_f.Read(fSize,sizeof(integer))<=0 then break;    //(2.3)取得压缩长度

      if getOneFile(fSize,aFileName) then                    //(2.4)获取压缩文件
      begin                                      
        frmMsg.moMsgs.lines.add(aFileName+' 解压缩成功!');  frmMsg.Update ;
      end else
      begin
        frmMsg.moMsgs.lines.add(aFileName+' 解压缩不成功!');  frmMsg.Update ;
      end;
    end; 
  finally
    src_f.free;
  end;
  except
    result:=false;
  end;
end;

本文地址：http://com.8s8s.com/it/it4811.htm