Moodsky 发表于 2007-2-8 10:25:50

数据压缩 -- 应用

例:多个目录下多个文件压缩到一个文件;
    对压缩文件解压到个对应目录。
   //压缩文件流: 文件名长度 + 文件名 + 文件长度 + 压缩流
   
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,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,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;
页: [1]
查看完整版本: 数据压缩 -- 应用